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. --- lib/tools/AUTHORS | 16 + lib/tools/Makefile | 37 + lib/tools/bin/.gitignore | 0 lib/tools/c_src/Makefile | 6 + lib/tools/c_src/Makefile.in | 239 + lib/tools/c_src/depend.mk | 17 + lib/tools/c_src/erl_memory.c | 2950 +++++++++++ lib/tools/c_src/erl_memory_trace_block_table.c | 761 +++ lib/tools/c_src/erl_memory_trace_block_table.h | 73 + lib/tools/doc/html/.gitignore | 0 lib/tools/doc/man3/.gitignore | 0 lib/tools/doc/pdf/.gitignore | 0 lib/tools/doc/src/Makefile | 132 + lib/tools/doc/src/book.xml | 47 + lib/tools/doc/src/cover.xml | 458 ++ lib/tools/doc/src/cover_chapter.xml | 490 ++ lib/tools/doc/src/cprof.xml | 294 ++ lib/tools/doc/src/cprof_chapter.xml | 228 + lib/tools/doc/src/eprof.xml | 150 + lib/tools/doc/src/erlang_mode.xml | 324 ++ lib/tools/doc/src/erlang_mode_chapter.xml | 251 + lib/tools/doc/src/fascicules.xml | 18 + lib/tools/doc/src/fprof.xml | 911 ++++ lib/tools/doc/src/fprof_chapter.xml | 141 + lib/tools/doc/src/instrument.xml | 432 ++ lib/tools/doc/src/make.dep | 33 + lib/tools/doc/src/make.xml | 144 + lib/tools/doc/src/note.gif | Bin 0 -> 1539 bytes lib/tools/doc/src/notes.xml | 475 ++ lib/tools/doc/src/notes_history.xml | 243 + lib/tools/doc/src/part.xml | 74 + lib/tools/doc/src/part_notes.xml | 38 + lib/tools/doc/src/part_notes_history.xml | 38 + lib/tools/doc/src/ref_man.xml | 77 + lib/tools/doc/src/tags.xml | 147 + lib/tools/doc/src/venn1.fig | 63 + lib/tools/doc/src/venn1.gif | Bin 0 -> 3025 bytes lib/tools/doc/src/venn1.ps | 205 + lib/tools/doc/src/venn2.fig | 97 + lib/tools/doc/src/venn2.gif | Bin 0 -> 3369 bytes lib/tools/doc/src/venn2.ps | 284 + lib/tools/doc/src/warning.gif | Bin 0 -> 1498 bytes lib/tools/doc/src/xref.xml | 1554 ++++++ lib/tools/doc/src/xref_chapter.xml | 383 ++ lib/tools/ebin/.gitignore | 0 lib/tools/emacs/AUTHORS | 15 + lib/tools/emacs/Makefile | 84 + lib/tools/emacs/README | 48 + lib/tools/emacs/erlang-eunit.el | 254 + lib/tools/emacs/erlang-start.el | 116 + lib/tools/emacs/erlang.el | 6651 ++++++++++++++++++++++++ lib/tools/emacs/erlang_appwiz.el | 1345 +++++ lib/tools/emacs/internal_doc/emacs.sgml | 3258 ++++++++++++ lib/tools/emacs/tags.3 | 61 + lib/tools/emacs/tags.erl | 1 + lib/tools/emacs/test.erl.indented | 536 ++ lib/tools/emacs/test.erl.orig | 536 ++ lib/tools/emacs/vsn.mk | 3 + lib/tools/examples/Makefile | 56 + lib/tools/examples/xref_examples.erl | 42 + lib/tools/info | 2 + lib/tools/obj/.gitignore | 0 lib/tools/priv/Makefile | 68 + lib/tools/priv/cover.tool | 2 + lib/tools/priv/index.html | 10 + lib/tools/src/Makefile | 112 + lib/tools/src/cover.erl | 2178 ++++++++ lib/tools/src/cover_web.erl | 1184 +++++ lib/tools/src/cprof.erl | 142 + lib/tools/src/eprof.erl | 478 ++ lib/tools/src/fprof.erl | 2762 ++++++++++ lib/tools/src/instrument.erl | 427 ++ lib/tools/src/make.erl | 324 ++ lib/tools/src/tags.erl | 344 ++ lib/tools/src/tools.app.src | 60 + lib/tools/src/tools.appup.src | 19 + lib/tools/src/xref.erl | 607 +++ lib/tools/src/xref.hrl | 106 + lib/tools/src/xref_base.erl | 1804 +++++++ lib/tools/src/xref_compiler.erl | 928 ++++ lib/tools/src/xref_parser.yrl | 303 ++ lib/tools/src/xref_reader.erl | 352 ++ lib/tools/src/xref_scanner.erl | 91 + lib/tools/src/xref_utils.erl | 725 +++ lib/tools/vsn.mk | 19 + 85 files changed, 37883 insertions(+) create mode 100644 lib/tools/AUTHORS create mode 100644 lib/tools/Makefile create mode 100644 lib/tools/bin/.gitignore create mode 100644 lib/tools/c_src/Makefile create mode 100644 lib/tools/c_src/Makefile.in create mode 100644 lib/tools/c_src/depend.mk create mode 100644 lib/tools/c_src/erl_memory.c create mode 100644 lib/tools/c_src/erl_memory_trace_block_table.c create mode 100644 lib/tools/c_src/erl_memory_trace_block_table.h create mode 100644 lib/tools/doc/html/.gitignore create mode 100644 lib/tools/doc/man3/.gitignore create mode 100644 lib/tools/doc/pdf/.gitignore create mode 100644 lib/tools/doc/src/Makefile create mode 100644 lib/tools/doc/src/book.xml create mode 100644 lib/tools/doc/src/cover.xml create mode 100644 lib/tools/doc/src/cover_chapter.xml create mode 100644 lib/tools/doc/src/cprof.xml create mode 100644 lib/tools/doc/src/cprof_chapter.xml create mode 100644 lib/tools/doc/src/eprof.xml create mode 100644 lib/tools/doc/src/erlang_mode.xml create mode 100644 lib/tools/doc/src/erlang_mode_chapter.xml create mode 100644 lib/tools/doc/src/fascicules.xml create mode 100644 lib/tools/doc/src/fprof.xml create mode 100644 lib/tools/doc/src/fprof_chapter.xml create mode 100644 lib/tools/doc/src/instrument.xml create mode 100644 lib/tools/doc/src/make.dep create mode 100644 lib/tools/doc/src/make.xml create mode 100644 lib/tools/doc/src/note.gif create mode 100644 lib/tools/doc/src/notes.xml create mode 100644 lib/tools/doc/src/notes_history.xml create mode 100644 lib/tools/doc/src/part.xml create mode 100644 lib/tools/doc/src/part_notes.xml create mode 100644 lib/tools/doc/src/part_notes_history.xml create mode 100644 lib/tools/doc/src/ref_man.xml create mode 100644 lib/tools/doc/src/tags.xml create mode 100644 lib/tools/doc/src/venn1.fig create mode 100644 lib/tools/doc/src/venn1.gif create mode 100644 lib/tools/doc/src/venn1.ps create mode 100644 lib/tools/doc/src/venn2.fig create mode 100644 lib/tools/doc/src/venn2.gif create mode 100644 lib/tools/doc/src/venn2.ps create mode 100644 lib/tools/doc/src/warning.gif create mode 100644 lib/tools/doc/src/xref.xml create mode 100644 lib/tools/doc/src/xref_chapter.xml create mode 100644 lib/tools/ebin/.gitignore create mode 100644 lib/tools/emacs/AUTHORS create mode 100644 lib/tools/emacs/Makefile create mode 100644 lib/tools/emacs/README create mode 100644 lib/tools/emacs/erlang-eunit.el create mode 100644 lib/tools/emacs/erlang-start.el create mode 100644 lib/tools/emacs/erlang.el create mode 100644 lib/tools/emacs/erlang_appwiz.el create mode 100644 lib/tools/emacs/internal_doc/emacs.sgml create mode 100644 lib/tools/emacs/tags.3 create mode 120000 lib/tools/emacs/tags.erl create mode 100644 lib/tools/emacs/test.erl.indented create mode 100644 lib/tools/emacs/test.erl.orig create mode 100644 lib/tools/emacs/vsn.mk create mode 100644 lib/tools/examples/Makefile create mode 100644 lib/tools/examples/xref_examples.erl create mode 100644 lib/tools/info create mode 100644 lib/tools/obj/.gitignore create mode 100644 lib/tools/priv/Makefile create mode 100644 lib/tools/priv/cover.tool create mode 100644 lib/tools/priv/index.html create mode 100644 lib/tools/src/Makefile create mode 100644 lib/tools/src/cover.erl create mode 100644 lib/tools/src/cover_web.erl create mode 100644 lib/tools/src/cprof.erl create mode 100644 lib/tools/src/eprof.erl create mode 100644 lib/tools/src/fprof.erl create mode 100644 lib/tools/src/instrument.erl create mode 100644 lib/tools/src/make.erl create mode 100644 lib/tools/src/tags.erl create mode 100644 lib/tools/src/tools.app.src create mode 100644 lib/tools/src/tools.appup.src create mode 100644 lib/tools/src/xref.erl create mode 100644 lib/tools/src/xref.hrl create mode 100644 lib/tools/src/xref_base.erl create mode 100644 lib/tools/src/xref_compiler.erl create mode 100644 lib/tools/src/xref_parser.yrl create mode 100644 lib/tools/src/xref_reader.erl create mode 100644 lib/tools/src/xref_scanner.erl create mode 100644 lib/tools/src/xref_utils.erl create mode 100644 lib/tools/vsn.mk (limited to 'lib/tools') diff --git a/lib/tools/AUTHORS b/lib/tools/AUTHORS new file mode 100644 index 0000000000..40e633c0d0 --- /dev/null +++ b/lib/tools/AUTHORS @@ -0,0 +1,16 @@ +Original Authors and Contributors: + +The modules in "tools" were written by a number of people including: + +Joe Armstrong +Claes Wikström +Joakim Hirsch +Robert Virding +Fredrik Gustafson +Gunilla Arendt +Raimo Niskanen +Ingela Anderton +Anders Lindgren +Arndt Jonasson +Rickard Green +Hans Bolinder \ No newline at end of file diff --git a/lib/tools/Makefile b/lib/tools/Makefile new file mode 100644 index 0000000000..685f3398e9 --- /dev/null +++ b/lib/tools/Makefile @@ -0,0 +1,37 @@ +# +# %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 + +# ---------------------------------------------------- +# Macros +# ---------------------------------------------------- + +SUB_DIRECTORIES = c_src src doc/src examples priv emacs + +include vsn.mk +VSN = $(TOOLS_VSN) + +SPECIAL_TARGETS = + +# ---------------------------------------------------- +# Default Subdir Targets +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_subdir.mk + diff --git a/lib/tools/bin/.gitignore b/lib/tools/bin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/tools/c_src/Makefile b/lib/tools/c_src/Makefile new file mode 100644 index 0000000000..0cdc50e6f5 --- /dev/null +++ b/lib/tools/c_src/Makefile @@ -0,0 +1,6 @@ +# +# Invoke with GNU make or clearmake -C gnu. +# + +include $(ERL_TOP)/make/run_make.mk + diff --git a/lib/tools/c_src/Makefile.in b/lib/tools/c_src/Makefile.in new file mode 100644 index 0000000000..e6b76e2238 --- /dev/null +++ b/lib/tools/c_src/Makefile.in @@ -0,0 +1,239 @@ +# ``The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance 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_TOP)/make/target.mk +include $(ERL_TOP)/erts/include/internal/$(TARGET)/ethread.mk + +USING_MINGW=@MIXED_CYGWIN_MINGW@ +USING_VC=@MIXED_CYGWIN_VC@ + +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@ +LDFLAGS=@LDFLAGS@ + +ifeq ($(TYPE),debug) +CFLAGS = @DEBUG_CFLAGS@ -DDEBUG +TYPEMARKER=.debug +PRE_LD = +ifeq ($(TARGET),win32) +LDFLAGS += -g +endif +else +ifeq ($(TYPE),purify) +CFLAGS = @CFLAGS@ -DPURIFY +TYPEMARKER=.purify +PRE_LD = purify $(PURIFY_BUILD_OPTIONS) +else +ifeq ($(TYPE),quantify) +CFLAGS = @CFLAGS@ -DQUANTIFY +TYPEMARKER=.quantify +PRE_LD = quantify $(QUANTIFY_BUILD_OPTIONS) +else +ifeq ($(TYPE),purecov) +CFLAGS = @DEBUG_CFLAGS@ -DPURECOV +TYPEMARKER=.purecov +PRE_LD = purecov $(PURECOV_BUILD_OPTIONS) +else +override TYPE=opt +CFLAGS = @CFLAGS@ +PRE_LD = +TYPEMARKER = +endif +endif +endif +endif + +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@ +CREATE_DIRS= + +TT_DIR=$(TARGET)/$(TYPE) + +BIN_DIR=../bin/$(TARGET) +OBJ_DIR=../obj/$(TT_DIR) + +CREATE_DIRS += $(BIN_DIR) $(OBJ_DIR) + +PROGS= +DRIVERS= + + +# +# emem sources, objects, includes, libs, etc... +# + + +ifneq ($(strip $(ETHR_LIB_NAME)),) +# Need ethread package for emem +PROGS += $(BIN_DIR)/emem$(TYPEMARKER)@EXEEXT@ +endif + +EMEM_OBJ_DIR=$(OBJ_DIR)/emem +CREATE_DIRS += $(EMEM_OBJ_DIR) + +EMEM_INCLUDES = -I$(ERL_TOP)/erts/include \ + -I$(ERL_TOP)/erts/include/$(TARGET) \ + -I$(ERL_TOP)/erts/include/internal \ + -I$(ERL_TOP)/erts/include/internal/$(TARGET) + +EMEM_HEADERS = erl_memory_trace_block_table.h +EMEM_SRCS = erl_memory.c erl_memory_trace_block_table.c + +EMEM_CFLAGS = $(THR_DEFS) $(subst O2,O3, $(CFLAGS)) $(EMEM_INCLUDES) +EMEM_LDFLAGS = $(LDFLAGS) + +ifeq ($(USING_VC), yes) +ifeq ($(TYPE),debug) +MT_LIB=MDd +else +MT_LIB=MD +endif + +EMEM_CFLAGS += -$(MT_LIB) +EMEM_LDFLAGS += -$(MT_LIB) +EMEM_ERTS_LIB=erts_$(MT_LIB)$(TYPEMARKER) + +else + +EMEM_ERTS_LIB=erts_r$(TYPEMARKER) + +endif + +EMEM_LIBS = $(LIBS) \ + -L$(ERL_TOP)/erts/lib/$(TARGET) \ + -L$(ERL_TOP)/erts/lib/internal/$(TARGET) \ + -l$(EMEM_ERTS_LIB) \ + -l$(ETHR_LIB_NAME)$(TYPEMARKER) \ + $(ETHR_X_LIBS) + +EMEM_OBJS = $(addprefix $(EMEM_OBJ_DIR)/,$(notdir $(EMEM_SRCS:.c=.o))) + +# +# Misc targets +# + +all: $(CREATE_DIRS) erts_lib $(PROGS) $(DRIVERS) + +erts_lib: + cd $(ERL_TOP)/erts/lib_src && $(MAKE) $(TYPE) + + +docs: + +clean: + $(RM) -rf ../obj/* + $(RM) -rf ../bin/* + $(RM) -f ./*~ + +.PHONY: all erts_lib docs clean + +# +# Make dir targets +# + +$(CREATE_DIRS): + $(MKDIR) -p $@ + +# +# Object targets +# + +$(EMEM_OBJ_DIR)/%.o: %.c + $(CC) $(EMEM_CFLAGS) -o $@ -c $< + +# +# Driver targets +# + +# +# Program targets +# + +$(BIN_DIR)/emem$(TYPEMARKER)@EXEEXT@: $(EMEM_OBJS) + $(PRE_LD) $(LD) $(EMEM_LDFLAGS) -o $@ $(EMEM_OBJS) $(EMEM_LIBS) + +# +# Release targets +# +include $(ERL_TOP)/make/otp_release_targets.mk +include ../vsn.mk +RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(TOOLS_VSN) + +release_spec: all + $(INSTALL_DIR) $(RELSYSDIR)/c_src + $(INSTALL_DATA) $(EMEM_SRCS) $(EMEM_HEADERS) $(RELSYSDIR)/c_src +ifneq ($(PROGS),) + $(INSTALL_DIR) $(RELSYSDIR)/bin + $(INSTALL_PROGRAM) $(PROGS) $(RELSYSDIR)/bin +endif + +release_docs_spec: + +.PHONY: release_spec release_docs_spec + +# +# Make dependencies +# + +ifeq ($(USING_VC), yes) +DEP_CC=@EMU_CC@ +else +DEP_CC=$(CC) +endif + +SED_REPL_EMEM_OBJ_DIR=s|^\([^:]*\)\.o:|$$(EMEM_OBJ_DIR)/\1.o:|g +SED_REPL_OBJ_DIR=s|^\([^:]*\)\.o:|$$(OBJ_DIR)/\1.o:|g +SED_REPL_TT_DIR=s|$(TT_DIR)/|$$(TT_DIR)/|g +SED_REPL_TARGET=s|$(TARGET)/|$$(TARGET)/|g +SED_REPL_ERL_TOP=s|$(ERL_TOP)/|$$(ERL_TOP)/|g + +SED_EMEM_DEPEND=sed '$(SED_REPL_EMEM_OBJ_DIR);$(SED_REPL_TT_DIR);$(SED_REPL_TARGET);$(SED_REPL_ERL_TOP)' +SED_DEPEND=sed '$(SED_REPL_OBJ_DIR);$(SED_REPL_TT_DIR);$(SED_REPL_TARGET);$(SED_REPL_ERL_TOP)' + +DEPEND_MK=depend.mk + +dep depend: + @echo "Generating dependency file $(DEPEND_MK)..." + @echo "# Generated dependency rules." > $(DEPEND_MK); + @echo "# Do *not* edit this file; instead, run 'make depend'." \ + >> $(DEPEND_MK); + @echo "# " >> $(DEPEND_MK); + @echo "# emem objects..." >> $(DEPEND_MK); + $(DEP_CC) -MM $(EMEM_CFLAGS) $(EMEM_SRCS) \ + | $(SED_EMEM_DEPEND) >> $(DEPEND_MK) + @echo "# EOF" >> $(DEPEND_MK); + +.PHONY: dep depend + +include $(DEPEND_MK) + +# eof diff --git a/lib/tools/c_src/depend.mk b/lib/tools/c_src/depend.mk new file mode 100644 index 0000000000..01da30e7c6 --- /dev/null +++ b/lib/tools/c_src/depend.mk @@ -0,0 +1,17 @@ +# Generated dependency rules. +# Do *not* edit this file; instead, run 'make depend'. +# +# emem objects... +$(EMEM_OBJ_DIR)/erl_memory.o: erl_memory.c \ + $(ERL_TOP)/erts/include/erl_fixed_size_int_types.h \ + $(ERL_TOP)/erts/include/$(TARGET)/erl_int_sizes_config.h \ + $(ERL_TOP)/erts/include/erl_memory_trace_parser.h \ + erl_memory_trace_block_table.h \ + $(ERL_TOP)/erts/include/internal/ethread.h \ + $(ERL_TOP)/erts/include/internal/$(TARGET)/ethread_header_config.h +$(EMEM_OBJ_DIR)/erl_memory_trace_block_table.o: erl_memory_trace_block_table.c \ + erl_memory_trace_block_table.h \ + $(ERL_TOP)/erts/include/erl_fixed_size_int_types.h \ + $(ERL_TOP)/erts/include/$(TARGET)/erl_int_sizes_config.h \ + $(ERL_TOP)/erts/include/erl_memory_trace_parser.h +# EOF diff --git a/lib/tools/c_src/erl_memory.c b/lib/tools/c_src/erl_memory.c new file mode 100644 index 0000000000..a0e139f059 --- /dev/null +++ b/lib/tools/c_src/erl_memory.c @@ -0,0 +1,2950 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance 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$ + */ + + +/* + * Description: + * + * Author: Rickard Green + */ + +/* Headers to include ... */ + +#ifdef __WIN32__ +# include +# undef WIN32_LEAN_AND_MEAN +# define WIN32_LEAN_AND_MEAN +# include +#else +# if defined(__linux__) && defined(__GNUC__) +# define _GNU_SOURCE 1 +# endif +# include +# include +# include +# include +# include +# include +# include +#endif + +#include +#include +#include +#include + +#include "erl_fixed_size_int_types.h" +#include "erl_memory_trace_parser.h" +#include "erl_memory_trace_block_table.h" +#include "ethread.h" + +/* Increment when changes are made */ +#define EMEM_VSN_STR "0.9" + +/* Features not fully implemented yet */ +#define EMEM_A_SWITCH 0 +#define EMEM_C_SWITCH 0 +#define EMEM_c_SWITCH 0 +#define EMEM_d_SWITCH 0 + +/* Some system specific defines ... */ +#ifdef __WIN32__ +# define ssize_t int +# define GET_SOCK_ERRNO() (WSAGetLastError() - WSABASEERR) +# define IS_INVALID_SOCKET(X) ((X) == INVALID_SOCKET) +# ifdef __GNUC__ +# define INLINE __inline__ +# else +# define INLINE __forceinline +# endif +# define DIR_SEP_CHAR '\\' +#else +# define SOCKET int +# define closesocket close +# define GET_SOCK_ERRNO() (errno ? errno : INT_MAX) +# define INVALID_SOCKET (-1) +# define IS_INVALID_SOCKET(X) ((X) < 0) +# ifdef __GNUC__ +# define INLINE __inline__ +# else +# define INLINE +# endif +# define DIR_SEP_CHAR '/' +#endif + +#define EM_ERL_CMD_FILE_NAME "erl_cmd.txt" +#define EM_OUTPUT_FILE_SUFFIX ".emem" + +#define PRINT_OPERATIONS 0 + +/* Our own assert() ... */ +#ifdef DEBUG +#define ASSERT(A) ((void) ((A) ? 1 : assert_failed(__FILE__, __LINE__, #A))) +#include +static int assert_failed(char *f, int l, char *a) +{ + fprintf(stderr, "%s:%d: Assertion failed: %s\n", f, l, a); + abort(); + return 0; +} + +#else +#define ASSERT(A) ((void) 1) +#endif + +#define ERR_RET(X) return (X) +#if 1 +# undef ERR_RET +# define ERR_RET(X) abort() +#endif + +/* #define HARD_DEBUG */ + + +#define EM_EXIT_RESULT (EMTBT_MIN_ERROR - 1) +#define EM_TRUNCATED_TRACE_ERROR (EMTBT_MIN_ERROR - 2) +#define EM_INTERNAL_ERROR (EMTBT_MIN_ERROR - 3) + +#define EM_DEFAULT_BUF_SZ 8192 + +#define EM_LINES_UNTIL_HEADER 20 +#define EM_NO_OF_OPS 400 +#define EM_MAX_CONSECUTIVE_TRACE_READS 10 +#define EM_MAX_NO_OF_TRACE_BUFS 1280 +#define EM_MIN_TRACE_READ_SIZE (EM_DEFAULT_BUF_SZ/20) +#define EM_TIME_FIELD_WIDTH 11 + +static void error(int res); +static void error_msg(int res, char *msg); + +typedef struct { + usgnd_int_max size; + usgnd_int_max min_size; + usgnd_int_max max_size; + usgnd_int_max max_ever_size; + usgnd_int_max no; + usgnd_int_max min_no; + usgnd_int_max max_no; + usgnd_int_max max_ever_no; + usgnd_int_max allocs; + usgnd_int_max reallocs; + usgnd_int_max frees; +} em_mem_info; + +typedef struct em_buffer_ { + struct em_buffer_ *next; + int write; + usgnd_int_8 *data; + usgnd_int_8 *data_end; + usgnd_int_8 *end; + size_t size; + usgnd_int_8 start[EM_DEFAULT_BUF_SZ]; +} em_buffer; + +typedef struct { + int no_writer; + int no_reader; + size_t tot_buf_size; + size_t max_buf_size; + char *name; + em_buffer *first; + em_buffer *last; + ethr_mutex mutex; + ethr_cond cond; + int used_def_buf_a; + em_buffer def_buf_a; + int used_def_buf_b; + em_buffer def_buf_b; +} em_buf_queue; + +typedef struct { + usgnd_int_8 *ptr; + size_t size; +} em_area; + +typedef struct { + char *name; + int ix; +} em_output_types; + +typedef struct { + + /* Memory allocation functions */ + void * (*alloc)(size_t); + void * (*realloc)(void *, size_t); + void (*free)(void *); + + emtbt_table *block_table; + emtbt_table **carrier_table; + + struct { + em_mem_info total; + em_mem_info *btype; + em_mem_info *allctr; + em_mem_info **allctr_prv_crr; + em_mem_info **allctr_usd_crr; + + struct { + usgnd_int_32 secs; + usgnd_int_32 usecs; + } stop_time; + emtp_op_type stop_reason; + usgnd_int_32 exit_status; + } info; + + /* Input ... */ + struct { + usgnd_int_16 listen_port; + SOCKET socket; + usgnd_int_max total_trace_size; + int error; + char *error_descr; + em_buf_queue queue; + } input; + + /* Output ... */ + struct { + usgnd_int_32 next_print; + usgnd_int_32 next_print_inc; + char *header; + size_t header_size; + size_t values_per_object; + size_t values_per_line; + size_t field_width; + int verbose; + int total; + int all_allctrs; + int no_allctrs; + em_output_types *allctrs; + int all_btypes; + int no_btypes; + em_output_types *btypes; + int max_min_values; + int block_counts; + int op_counts; + int lines_until_header; + FILE *stream; + char *file_name; +#if EMEM_d_SWITCH + char *dir_name; + FILE *erl_cmd_file; + struct { + ethr_mutex *mutex; + ethr_cond *cond; + } go; +#endif + em_buf_queue queue; + } output; + + /* Trace info */ + emtp_state *trace_state; + emtp_info trace_info; + +} em_state; + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Threads... * + * * +\* */ + +static INLINE void +mutex_init(ethr_mutex *mtx) +{ + int res = ethr_mutex_init(mtx); + if (res) + error_msg(res, "Mutex init"); +} + +static INLINE void +mutex_destroy(ethr_mutex *mtx) +{ + int res = ethr_mutex_destroy(mtx); + if (res) + error_msg(res, "Mutex destroy"); +} + +static INLINE void +mutex_lock(ethr_mutex *mtx) +{ + int res = ethr_mutex_lock(mtx); + if (res) + error_msg(res, "Mutex lock"); +} + +static INLINE void +mutex_unlock(ethr_mutex *mtx) +{ + int res = ethr_mutex_unlock(mtx); + if (res) + error_msg(res, "Mutex unlock"); +} + +static INLINE void +cond_init(ethr_cond *cnd) +{ + int res = ethr_cond_init(cnd); + if (res) + error_msg(res, "Cond init"); +} + +static INLINE void +cond_destroy(ethr_cond *cnd) +{ + int res = ethr_cond_destroy(cnd); + if (res) + error_msg(res, "Cond destroy"); +} + +static INLINE void +cond_wait(ethr_cond *cnd, ethr_mutex *mtx) +{ + int res = ethr_cond_wait(cnd, mtx); + if (res) + error_msg(res, "Cond wait"); +} + +static INLINE void +cond_signal(ethr_cond *cnd) +{ + int res = ethr_cond_signal(cnd); + if (res) + error_msg(res, "Cond signal"); +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Buffer queues * + * * +\* */ + +static INLINE void +reset_buffer(em_buffer *b, size_t size) +{ + b->write = 1; + b->next = NULL; + if (size) { + b->size = size; + b->end = b->start + size; + } + b->data_end = b->data = b->start; +} + +static void +init_queue(em_state *state, em_buf_queue *queue) +{ + reset_buffer(&queue->def_buf_a, EM_DEFAULT_BUF_SZ); + reset_buffer(&queue->def_buf_b, EM_DEFAULT_BUF_SZ); + queue->first = NULL; + queue->last = NULL; + queue->no_writer = 0; + queue->no_reader = 0; + queue->tot_buf_size = 0; + queue->max_buf_size = ~0; + queue->name = ""; + queue->used_def_buf_a = 0; + queue->used_def_buf_b = 0; + mutex_init(&queue->mutex); + cond_init(&queue->cond); +} + +static void +destroy_queue(em_state *state, em_buf_queue *queue) +{ + while (queue->first) { + em_buffer *buf = queue->first; + queue->first = queue->first->next; + if (buf != &queue->def_buf_a && buf != &queue->def_buf_b) + (*state->free)((void *) buf); + } + mutex_destroy(&queue->mutex); + cond_destroy(&queue->cond); +} + +static void +disconnect_queue_writer(em_buf_queue *queue) +{ + mutex_lock(&queue->mutex); + queue->no_writer = 1; + cond_signal(&queue->cond); + mutex_unlock(&queue->mutex); +} + +static void +disconnect_queue_reader(em_buf_queue *queue) +{ + mutex_lock(&queue->mutex); + queue->no_reader = 1; + cond_signal(&queue->cond); + mutex_unlock(&queue->mutex); +} + +static int +is_queue_writer_disconnected(em_buf_queue *queue) +{ + int res; + mutex_lock(&queue->mutex); + res = queue->no_writer; + mutex_unlock(&queue->mutex); + return res; +} + +static int +is_queue_reader_disconnected(em_buf_queue *queue) +{ + int res; + mutex_lock(&queue->mutex); + res = queue->no_reader; + mutex_unlock(&queue->mutex); + return res; +} + +static INLINE void +dequeue(em_state *state, em_buf_queue *queue) +{ + em_buffer *buf; + + ASSERT(queue->first); + ASSERT(queue->tot_buf_size > 0); + + buf = queue->first; + queue->first = buf->next; + if (!queue->first) + queue->last = NULL; + + ASSERT(queue->tot_buf_size >= buf->size); + queue->tot_buf_size -= buf->size; + + if (buf == &queue->def_buf_a) + queue->used_def_buf_a = 0; + else if (buf == &queue->def_buf_b) + queue->used_def_buf_b = 0; + else + (*state->free)((void *) buf); + +} + + +static INLINE em_buffer * +enqueue(em_state *state, em_buf_queue *queue, size_t min_size) +{ + em_buffer *buf; + + if (min_size > EM_DEFAULT_BUF_SZ) + goto alloc_buf; + + if (!queue->used_def_buf_a) { + buf = &queue->def_buf_a; + queue->used_def_buf_a = 1; + reset_buffer(buf, 0); + } + else if (!queue->used_def_buf_b) { + buf = &queue->def_buf_b; + queue->used_def_buf_b = 1; + reset_buffer(buf, 0); + } + else { + size_t bsize; + alloc_buf: + + bsize = EM_DEFAULT_BUF_SZ; + if (bsize < min_size) + bsize = min_size; + + buf = (em_buffer *) (*state->alloc)(sizeof(em_buffer) + + (sizeof(usgnd_int_8) + * (bsize-EM_DEFAULT_BUF_SZ))); + if (buf) { + buf->size = bsize; + reset_buffer(buf, bsize); + } + } + + if (queue->last) { + ASSERT(queue->first); + queue->last->write = 0; + queue->last->next = buf; + } + else { + ASSERT(!queue->first); + queue->first = buf; + } + + queue->tot_buf_size += buf->size; + queue->last = buf; + + return buf; +} + +static void +get_next_read_area(em_area *area, em_state *state, em_buf_queue *queue) +{ + mutex_lock(&queue->mutex); + + while (!queue->first || queue->first->data == queue->first->data_end) { + if (queue->first && (!queue->first->write + || queue->first->data == queue->first->end)) { + dequeue(state, queue); + continue; + } + + if (queue->no_writer) { + area->ptr = NULL; + area->size = 0; + mutex_unlock(&queue->mutex); + return; + } + cond_wait(&queue->cond, &queue->mutex); + } + + ASSERT(queue->first->data < queue->first->data_end); + + area->ptr = queue->first->data; + area->size = queue->first->data_end - queue->first->data; + + queue->first->data = queue->first->data_end; + + mutex_unlock(&queue->mutex); +} + +static INLINE void +wrote_area_aux(em_area *area, em_state *state, em_buf_queue *queue, int do_lock) +{ + em_buffer *buf; + + if (do_lock) + mutex_lock(&queue->mutex); + + buf = queue->last; + + ASSERT(area->ptr); + ASSERT(area->size); + + ASSERT(buf); + ASSERT(buf->data_end == area->ptr); + ASSERT(buf->end >= area->ptr + area->size); + + buf->data_end = area->ptr + area->size; + + area->ptr = NULL; + area->size = 0; + + cond_signal(&queue->cond); + + if (do_lock) + mutex_unlock(&queue->mutex); +} + +static INLINE void +wrote_area(em_area *area, em_state *state, em_buf_queue *queue) +{ + wrote_area_aux(area, state, queue, 1); +} + +static void +get_next_write_area(em_area *area, em_state *state, em_buf_queue *queue, + size_t size) +{ + em_buffer *buf; + + mutex_lock(&queue->mutex); + + ASSERT(!area->size || area->ptr); + + if (area->size) + wrote_area_aux(area, state, queue, 0); + + buf = ((queue->last && queue->last->end - queue->last->data_end >= size) + ? queue->last + : enqueue(state, queue, size)); + + if (buf) { + ASSERT(buf->end - buf->data_end >= size); + area->ptr = buf->data_end; + area->size = buf->end - buf->data_end; + } + else { + area->ptr = NULL; + area->size = 0; + } + + if (queue->tot_buf_size > queue->max_buf_size) { + fprintf(stderr, + "emem: Maximum %s buffer size (%lu) exceeded. " + "Terminating...\n", + queue->name, + (unsigned long) queue->max_buf_size); + exit(1); + } + + mutex_unlock(&queue->mutex); + +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Output * + * * +\* */ + +static INLINE size_t +write_str(usgnd_int_8 **dstpp, char *srcp) +{ + size_t i = 0; + if (dstpp) + while (srcp[i]) + *((*dstpp)++) = (usgnd_int_8) srcp[i++]; + else + while (srcp[i]) i++; + return i; +} + + +static size_t +write_strings(usgnd_int_8 **ptr, + char **strings, + char *first_line_prefix, + char *line_prefix, + size_t max_line_size) +{ + size_t size; + size_t tot_size = 0; + size_t line_size = 0; + size_t line_prefix_size; + sgnd_int_32 ix; + + tot_size = line_size = line_prefix_size = write_str(ptr, first_line_prefix); + + for (ix = 0; strings[ix]; ix++) { + size = write_str(NULL, strings[ix]); + if (line_size + 1 + size > max_line_size) { + tot_size += write_str(ptr, "\n"); + tot_size += write_str(ptr, line_prefix); + line_size = line_prefix_size; + } + tot_size += write_str(ptr, " "); + tot_size += ptr ? write_str(ptr, strings[ix]) : size; + line_size += 1 + size; + } + + tot_size += write_str(ptr, "\n"); + + return tot_size; +} + +static size_t +write_title(usgnd_int_8 **bufp, size_t *overflow, size_t width, char *str) +{ + size_t i, sz, ws; + usgnd_int_8 *p, *endp; + + /* + * Writes at least one '|' character at the beginning. + * Right aligns "str". + * If "str" is larger than "width - 1" and overflow is NULL, + * then "str" is trucated; otherwise, string is not truncated. + */ + + if (width <= 0) + return 0; + + if (!bufp && !overflow) + return width; + + sz = strlen(str) + 1; + if (sz > width) { + ws = 0; + if (overflow) + *overflow += sz - width; + else + sz = width; + } + else { + ws = width - sz; + if (overflow) { + if (ws >= *overflow) { + ws -= *overflow; + *overflow = 0; + } + else { + *overflow -= ws; + ws = 0; + } + } + sz += ws; + } + if (!bufp) + return sz; + + p = *bufp; + endp = p + width; + + *(p++) = '|'; + while (ws > 1) { + ws--; + *(p++) = (usgnd_int_8) ' '; + } + + i = 0; + while (str[i] && (overflow || p < endp)) + *(p++) = (usgnd_int_8) str[i++]; + + while (ws) { + ws--; + *(p++) = (usgnd_int_8) ' '; + } + + ASSERT(overflow || p == endp); + ASSERT(sz == (size_t) (p - *bufp)); + *bufp = p; + return sz; +} + +static size_t +write_obj_sub_titles(em_state *state, usgnd_int_8 **bufp, size_t *overflow) +{ + size_t field_width = state->output.field_width; + size_t size = write_title(bufp, overflow, field_width, "size"); + if (state->output.max_min_values) { + size += write_title(bufp, overflow, field_width, "min size"); + size += write_title(bufp, overflow, field_width, "max size"); + } + if (state->output.block_counts) { + size += write_title(bufp, overflow, field_width, "no"); + if (state->output.max_min_values) { + size += write_title(bufp, overflow, field_width, "min no"); + size += write_title(bufp, overflow, field_width, "max no"); + } + } + if (state->output.op_counts) { + size += write_title(bufp, overflow, field_width, "alloc()"); + size += write_title(bufp, overflow, field_width, "realloc()"); + size += write_title(bufp, overflow, field_width, "free()"); + } + + return size; +} + +static size_t +write_header(em_state *state, usgnd_int_8 *ptr, int trunc) +{ +#define MIN_LTEXT_SZ 18 +#define HEADER_EOL_STR "|\n" + usgnd_int_8 *p; + usgnd_int_8 **pp; + int i; + size_t overflow; + size_t *ofp; + size_t obj_size = state->output.values_per_object*state->output.field_width; + size_t size = 0; + int have_seg_crr = state->trace_info.have_segment_carrier_info; + + if (ptr) { + p = ptr; + pp = &p; + } + else { + p = NULL; + pp = NULL; + } + + overflow = 0; + ofp = trunc ? NULL : &overflow; + + size += write_title(pp, ofp, EM_TIME_FIELD_WIDTH, "time"); + + if (state->output.total) { + int no = 1; + if (have_seg_crr) { + if (state->info.allctr_prv_crr[state->trace_info.segment_ix]) + no++; + if (state->info.allctr_usd_crr[state->trace_info.segment_ix]) + no++; + } + size += write_title(pp, ofp, (have_seg_crr ? 3 : 1)*obj_size, "total"); + } + + for (i = 0; i < state->output.no_allctrs; i++) { + int no = 1; + if (state->info.allctr_prv_crr[state->output.allctrs[i].ix]) + no++; + if (state->info.allctr_usd_crr[state->output.allctrs[i].ix]) + no++; + size += write_title(pp, ofp, no*obj_size, state->output.allctrs[i].name); + } + + for (i = 0; i < state->output.no_btypes; i++) + size += write_title(pp, ofp, obj_size, state->output.btypes[i].name); + + size += write_str(pp, HEADER_EOL_STR); + + overflow = 0; + size += write_title(pp, ofp, EM_TIME_FIELD_WIDTH, ""); + + if (state->output.total) { + size += write_title(pp, ofp, obj_size, (obj_size <= MIN_LTEXT_SZ + ? "alcd blks" + : "allocated blocks")); + if (have_seg_crr) { + if (state->info.allctr_prv_crr[state->trace_info.segment_ix]) + size += write_title(pp, ofp, obj_size, (obj_size <= MIN_LTEXT_SZ + ? "mpd segs" + : "mapped segments")); + if (state->info.allctr_usd_crr[state->trace_info.segment_ix]) + size += write_title(pp, ofp, obj_size, (obj_size <= MIN_LTEXT_SZ + ? "chd segs" + : "cached segments")); + } + } + + for (i = 0; i < state->output.no_allctrs; i++) { + size += write_title(pp, ofp, obj_size, (obj_size <= MIN_LTEXT_SZ + ? "alcd blks" + : "allocated blocks")); + if (state->info.allctr_prv_crr[state->output.allctrs[i].ix]) + size += write_title(pp, ofp, obj_size, (obj_size <= MIN_LTEXT_SZ + ? "prvd crrs" + : "provided carriers")); + if (state->info.allctr_usd_crr[state->output.allctrs[i].ix]) + size += write_title(pp, ofp, obj_size, (obj_size <= MIN_LTEXT_SZ + ? "usd crrs" + : "used carriers")); + } + for (i = 0; i < state->output.no_btypes; i++) + size += write_title(pp, ofp, obj_size, (obj_size <= MIN_LTEXT_SZ + ? "alcd blks" + : "allocated blocks")); + + + size += write_str(pp, HEADER_EOL_STR); + overflow = 0; + size += write_title(pp, ofp, EM_TIME_FIELD_WIDTH, ""); + + if (state->output.total) { + size += write_obj_sub_titles(state, pp, ofp); + if (have_seg_crr) { + if (state->info.allctr_prv_crr[state->trace_info.segment_ix]) + size += write_obj_sub_titles(state, pp, ofp); + if (state->info.allctr_usd_crr[state->trace_info.segment_ix]) + size += write_obj_sub_titles(state, pp, ofp); + } + } + + for (i = 0; i < state->output.no_allctrs; i++) { + size += write_obj_sub_titles(state, pp, ofp); + if (state->info.allctr_prv_crr[state->output.allctrs[i].ix]) + size += write_obj_sub_titles(state, pp, ofp); + if (state->info.allctr_usd_crr[state->output.allctrs[i].ix]) + size += write_obj_sub_titles(state, pp, ofp); + } + + for (i = 0; i < state->output.no_btypes; i++) + size += write_obj_sub_titles(state, pp, ofp); + + size += write_str(pp, HEADER_EOL_STR); +#undef MIN_LTEXT_SZ +#undef HEADER_EOL_STR + return size; +} + +static INLINE void +write_mem_info(em_state *state, usgnd_int_8 **p, em_mem_info *mi) +{ + int fw = state->output.field_width - 1; + *p += sprintf(*p, "%*" USGND_INT_MAX_FSTR " ", fw, mi->size); + if (state->output.max_min_values) + *p += sprintf(*p, + "%*" USGND_INT_MAX_FSTR + " %*" USGND_INT_MAX_FSTR " ", + fw, mi->min_size, + fw, mi->max_size); + if (state->output.block_counts) { + *p += sprintf(*p, "%*" USGND_INT_MAX_FSTR " ", fw, mi->no); + if (state->output.max_min_values) + *p += sprintf(*p, + "%*" USGND_INT_MAX_FSTR + " %*" USGND_INT_MAX_FSTR " ", + fw, mi->min_no, + fw, mi->max_no); + } + if (state->output.op_counts) + *p += sprintf(*p, + "%*" USGND_INT_MAX_FSTR + " %*" USGND_INT_MAX_FSTR + " %*" USGND_INT_MAX_FSTR " ", + fw, mi->allocs, + fw, mi->reallocs, + fw, mi->frees); + + /* Update max ever values */ + if (mi->max_ever_size < mi->max_size) + mi->max_ever_size = mi->max_size; + if (mi->max_ever_no < mi->max_no) + mi->max_ever_no = mi->max_no; + /* Reset max/min values */ + mi->max_size = mi->min_size = mi->size; + mi->max_no = mi->min_no = mi->no; +} + +static INLINE void +write_max_ever_mem_info(em_state *state, usgnd_int_8 **p, em_mem_info *mi) +{ + int fw = state->output.field_width - 1; + *p += sprintf(*p, "%*" USGND_INT_MAX_FSTR " ", fw, mi->max_ever_size); + if (state->output.max_min_values) + *p += sprintf(*p, "%*s %*s ", fw, "", fw, ""); + if (state->output.block_counts) { + *p += sprintf(*p, "%*" USGND_INT_MAX_FSTR " ", fw, mi->max_ever_no); + if (state->output.max_min_values) + *p += sprintf(*p, "%*s %*s ", fw, "", fw, ""); + } + if (state->output.op_counts) + *p += sprintf(*p, "%*s %*s %*s ", fw, "", fw, "", fw, ""); +} + +static void +print_string(em_state *state, char *str) +{ + em_area area = {NULL, 0}; + usgnd_int_8 *p; + + /* Get area */ + + get_next_write_area(&area,state,&state->output.queue,write_str(NULL,str)); + + p = (usgnd_int_8 *) area.ptr; + area.size = write_str(&p, str); + + /* Leave area */ + + wrote_area(&area, state, &state->output.queue); + +} + +static int +print_emu_arg(em_state *state) +{ + em_area area = {NULL, 0}; + char hostname[100]; + char carg[22]; + struct sockaddr_in saddr; + struct hostent *hp; + struct in_addr iaddr; + usgnd_int_16 port; + int saddr_size = sizeof(saddr); + size_t size; + char *format = "> Emulator command line argument: +Mit %s\n"; + + if (getsockname(state->input.socket, + (struct sockaddr *) &saddr, + &saddr_size) != 0) + goto error; + + port = ntohs(saddr.sin_port); + + ASSERT(state->input.listen_port == 0 || state->input.listen_port == port); + + state->input.listen_port = port; + + if (gethostname(hostname, sizeof(hostname)) != 0) + goto error; + + hp = gethostbyname(hostname); + if (!hp) + goto error; + + if (hp->h_addr_list) { + (void) memcpy(&iaddr.s_addr, *hp->h_addr_list, sizeof(iaddr.s_addr)); + (void) sprintf(carg, "%s:%d", inet_ntoa(iaddr), (int) port); + } + else + (void) sprintf(carg, "127.0.0.1:%d", (int) port); + +#if EMEM_d_SWITCH + + if (state->output.erl_cmd_file) { + fprintf(state->output.erl_cmd_file, "+Mit %s\n", carg); + fclose(state->output.erl_cmd_file); + state->output.erl_cmd_file = NULL; + } + +#endif + + size = strlen(format) + strlen(carg); + + /* Get area */ + + get_next_write_area(&area, state, &state->output.queue, size); + + area.size = sprintf(area.ptr, format, carg); + + /* Leave area */ + + wrote_area(&area, state, &state->output.queue); + + return 0; + + error: + return GET_SOCK_ERRNO(); +} + +static size_t +write_allocator_info(em_state *state, usgnd_int_8 *ptr) +{ + usgnd_int_32 aix, i, j; + char *header = "> Allocator information:\n"; + char *allctr_str = "> * Allocator:"; + char *crr_prv_str = "> * Carrier providers:"; + char *blk_tp_str = "> * Block types:"; + char *line_prefix = "> "; + size_t size = 0; + char **strings; + size_t strings_size; + size_t max_line_size = 80; + usgnd_int_8 *p = ptr; + usgnd_int_8 **pp = ptr ? &p : NULL; + + strings_size = state->trace_info.max_block_type_ix + 1; + if (strings_size < state->trace_info.max_allocator_ix + 1) + strings_size = state->trace_info.max_allocator_ix + 1; + + strings = (char **) (*state->alloc)((strings_size + 1)*sizeof(char *)); + if (!strings) + error(ENOMEM); + + size += write_str(pp, header); + + for (aix = 0; aix <= state->trace_info.max_allocator_ix; aix++) { + emtp_allocator *allctr = state->trace_info.allocator[aix]; + if (!allctr->valid) + continue; + + strings[0] = allctr->name; + strings[1] = NULL; + size += write_strings(pp,strings,allctr_str,line_prefix,max_line_size); + + i = 0; + if (allctr->carrier.provider) + for (j = 0; j < allctr->carrier.no_providers; j++) { + usgnd_int_32 cpix = allctr->carrier.provider[j]; + if (cpix == state->trace_info.segment_ix) + strings[i++] = "segment"; + else + strings[i++] = state->trace_info.allocator[cpix]->name; + } + strings[i] = NULL; + size += write_strings(pp,strings,crr_prv_str,line_prefix,max_line_size); + + i = 0; + for (j = 0; j <= state->trace_info.max_block_type_ix; j++) + if (state->trace_info.block_type[j]->allocator == aix) + strings[i++] = state->trace_info.block_type[j]->name; + strings[i] = NULL; + size += write_strings(pp,strings,blk_tp_str,line_prefix,max_line_size); + } + + (*state->free)((void *) strings); + + return size; +} + +static void +print_main_header(em_state *state) +{ +#if HAVE_INT_64 +#define MAX_WORD_SZ_STR "64" +#else +#define MAX_WORD_SZ_STR "32" +#endif + em_area area = {NULL, 0}; + char *format1 = + "> emem version: " EMEM_VSN_STR "\n" + "> Nodename: %s\n" + "> Hostname: %s\n" + "> Pid: %s\n" + "> Start time (UTC): "; + char *format2 = "%4.4" USGND_INT_32_FSTR + "-%2.2" USGND_INT_32_FSTR "-%2.2" USGND_INT_32_FSTR + " %2.2" USGND_INT_32_FSTR ":%2.2" USGND_INT_32_FSTR + ":%2.2" USGND_INT_32_FSTR ".%6.6" USGND_INT_32_FSTR "\n"; + char *format3 = + "> Trace parser version: %" USGND_INT_32_FSTR ".%" USGND_INT_32_FSTR + "\n" + "> Actual trace version: %" USGND_INT_32_FSTR ".%" USGND_INT_32_FSTR + "\n" + "> Maximum trace word size: " MAX_WORD_SZ_STR " bits\n" + "> Actual trace word size: %d bits\n"; + size_t size = (strlen(format1) + + (state->trace_info.start_time.month + ? (strlen(format2) + 7*10) + : 1) + + strlen(format3) + + strlen(state->trace_info.nodename) + + strlen(state->trace_info.hostname) + + strlen(state->trace_info.pid) + + 5*10 + 1); + + if (state->output.verbose) { + size += write_allocator_info(state, NULL); + } + + size += write_header(state, NULL, 0); + + /* Get area */ + get_next_write_area(&area, state, &state->output.queue, size); + + area.size = sprintf(area.ptr, + format1, + state->trace_info.nodename, + state->trace_info.hostname, + state->trace_info.pid); + if (state->trace_info.start_time.month) + area.size += sprintf(area.ptr + area.size, + format2, + state->trace_info.start_time.year, + state->trace_info.start_time.month, + state->trace_info.start_time.day, + state->trace_info.start_time.hour, + state->trace_info.start_time.minute, + state->trace_info.start_time.second, + state->trace_info.start_time.micro_second); + else + *(area.ptr + area.size++) = '\n'; + area.size += sprintf(area.ptr + area.size, + format3, + state->trace_info.version.parser.major, + state->trace_info.version.parser.minor, + state->trace_info.version.trace.major, + state->trace_info.version.trace.minor, + state->trace_info.bits); + + if (state->output.verbose) { + area.size += write_allocator_info(state, area.ptr + area.size); + } + + area.size += write_header(state, area.ptr + area.size, 0); + + /* Leave area */ + wrote_area(&area, state, &state->output.queue); +#undef MAX_WORD_SZ_STR +} + +static void +print_main_footer(em_state *state) +{ + em_area area = {NULL, 0}; + usgnd_int_8 *p; + int i; + char *stop_str = + "> Trace stopped\n"; + char *exit_str = + "> Emulator exited with code: %" USGND_INT_32_FSTR "\n"; + char *format = + "> Total trace size: %" USGND_INT_MAX_FSTR " bytes\n" + "> Average band width used: %" USGND_INT_MAX_FSTR " Kbit/s\n"; + size_t size; + usgnd_int_max tsz = state->input.total_trace_size; + usgnd_int_32 secs = state->info.stop_time.secs; + usgnd_int_32 usecs = state->info.stop_time.usecs; + usgnd_int_max bw; + + /* Max size of the max value line. Each value can at most use 21 + characters: largest possible usgnd_int_64 (20 digits) and one + white space. */ + size = state->output.values_per_line*21 + 1; + + switch (state->info.stop_reason) { + case EMTP_STOP: + size += strlen(stop_str) + 1; + break; + case EMTP_EXIT: + size += strlen(exit_str); + size += 10; /* Enough for one unsgn_int_32 */ + size++; + break; + default: + break; + } + size += strlen(format); + size += 2*20; /* Enough for two unsgn_int_64 */ + size += 2; + + bw = (tsz + 1023)/1024; + bw *= 1000; + bw /= secs*1000 + usecs/1000; + bw *= 8; + + /* Get area */ + + get_next_write_area(&area, state, &state->output.queue, size); + + p = area.ptr; + + p += sprintf(p, "> %-*s", EM_TIME_FIELD_WIDTH - 2, "Maximum:"); + + if (state->output.total) { + int six = state->trace_info.segment_ix; + write_max_ever_mem_info(state, &p, &state->info.total); + if (state->trace_info.have_segment_carrier_info) { + if (state->info.allctr_prv_crr[six]) + write_max_ever_mem_info(state, + &p, + state->info.allctr_prv_crr[six]); + if (state->info.allctr_usd_crr[six]) + write_max_ever_mem_info(state, + &p, + state->info.allctr_usd_crr[six]); + } + } + for (i = 0; i < state->output.no_allctrs; i++) { + int ix = state->output.allctrs[i].ix; + write_max_ever_mem_info(state, &p, &state->info.allctr[ix]); + if (state->info.allctr_prv_crr[ix]) + write_max_ever_mem_info(state, + &p, + state->info.allctr_prv_crr[ix]); + if (state->info.allctr_usd_crr[ix]) + write_max_ever_mem_info(state, + &p, + state->info.allctr_usd_crr[ix]); + } + for (i = 0; i < state->output.no_btypes; i++) + write_max_ever_mem_info(state, + &p, + &state->info.btype[state->output.btypes[i].ix]); + + p += sprintf(p, "\n"); + + switch (state->info.stop_reason) { + case EMTP_STOP: + p += sprintf(p, stop_str); + break; + case EMTP_EXIT: + p += sprintf(p, exit_str, state->info.exit_status); + break; + default: + break; + } + + p += sprintf(p, format, tsz, bw); + + area.size = p - area.ptr; + + ASSERT(area.size <= size); + + /* Leave area */ + + wrote_area(&area, state, &state->output.queue); + +} + +static void +print_info(em_state *state, usgnd_int_32 secs, char *extra) +{ + usgnd_int_8 *p; + int i; + size_t size; + em_area area = {NULL, 0}; + + /* Get area */ + + size = 0; + if (!state->output.lines_until_header) + size += state->output.header_size; + + /* Max size of one line of values. Each value can at most use 21 + characters: largest possible usgnd_int_64 (20 digits) and one white + space. */ + size += state->output.values_per_line*21 + 1; + + if (extra) + size += write_str(NULL, extra); + + get_next_write_area(&area, state, &state->output.queue, size); + + /* Write to area */ + + p = area.ptr; + + if (!state->output.lines_until_header) { + memcpy((void *) area.ptr, + (void *) state->output.header, + state->output.header_size); + p += state->output.header_size; + state->output.lines_until_header = EM_LINES_UNTIL_HEADER; + } + else + state->output.lines_until_header--; + + p += sprintf(p, "%*" USGND_INT_32_FSTR " ", EM_TIME_FIELD_WIDTH - 1, secs); + + if (state->output.total) { + int six = state->trace_info.segment_ix; + write_mem_info(state, &p, &state->info.total); + if (state->trace_info.have_segment_carrier_info) { + if (state->info.allctr_prv_crr[six]) + write_mem_info(state, &p, state->info.allctr_prv_crr[six]); + if (state->info.allctr_usd_crr[six]) + write_mem_info(state, &p, state->info.allctr_usd_crr[six]); + } + } + for (i = 0; i < state->output.no_allctrs; i++) { + int ix = state->output.allctrs[i].ix; + write_mem_info(state, &p, &state->info.allctr[ix]); + if (state->info.allctr_prv_crr[ix]) + write_mem_info(state, &p, state->info.allctr_prv_crr[ix]); + if (state->info.allctr_usd_crr[ix]) + write_mem_info(state, &p, state->info.allctr_usd_crr[ix]); + } + for (i = 0; i < state->output.no_btypes; i++) + write_mem_info(state, + &p, + &state->info.btype[state->output.btypes[i].ix]); + + p += sprintf(p, "\n"); + + if (extra) + p += write_str(&p, extra); + + ASSERT(area.size >= p - area.ptr); + area.size = p - area.ptr; + + /* Leave area */ + + wrote_area(&area, state, &state->output.queue); +} + +static void +reset_mem_info(em_mem_info *mi) +{ + mi->size = 0; + mi->min_size = 0; + mi->max_size = 0; + mi->max_ever_size = 0; + mi->no = 0; + mi->min_no = 0; + mi->max_no = 0; + mi->max_ever_no = 0; + mi->allocs = 0; + mi->reallocs = 0; + mi->frees = 0; +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * State creation and destruction * + * * +\* */ + +static void +destroy_state(em_state *state) +{ + int i; + void (*freep)(void *); + + freep = state->free; + + if (state->block_table) + emtbt_destroy_table(state->block_table); + + if (state->carrier_table) { + for (i = -1; i <= state->trace_info.max_allocator_ix; i++) + if (state->carrier_table[i]) + emtbt_destroy_table(state->carrier_table[i]); + state->carrier_table--; + (*freep)((void *) state->carrier_table); + } + + if (state->info.btype) { + state->info.btype--; + (*freep)((void *) state->info.btype); + } + + if (state->info.allctr) { + state->info.allctr--; + (*freep)((void *) state->info.allctr); + } + + if (state->info.allctr_prv_crr) { + for (i = -1; i <= state->trace_info.max_allocator_ix; i++) + if (state->info.allctr_prv_crr[i]) + (*freep)((void *) state->info.allctr_prv_crr[i]); + state->info.allctr_prv_crr--; + (*freep)((void *) state->info.allctr_prv_crr); + } + + + if (state->info.allctr_usd_crr) { + for (i = -1; i <= state->trace_info.max_allocator_ix; i++) + if (state->info.allctr_usd_crr[i]) + (*freep)((void *) state->info.allctr_usd_crr[i]); + state->info.allctr_usd_crr--; + (*freep)((void *) state->info.allctr_usd_crr); + } + + emtp_state_destroy(state->trace_state); + destroy_queue(state, &state->input.queue); + + if (state->output.btypes) + (*freep)((void *) state->output.btypes); + if (state->output.allctrs) + (*freep)((void *) state->output.allctrs); + destroy_queue(state, &state->output.queue); + +#if EMEM_d_SWITCH + + if (state->output.go.mutex) { + mutex_destroy(state->output.go.mutex); + (*state->free)((void *) state->output.go.mutex); + state->output.go.mutex = NULL; + } + if (state->output.go.cond) { + cond_destroy(state->output.go.cond); + (*state->free)((void *) state->output.go.cond); + state->output.go.cond = NULL; + } + +#endif + + if (!IS_INVALID_SOCKET(state->input.socket)) { + closesocket(state->input.socket); + state->input.socket = INVALID_SOCKET; + } + + (*freep)((void *) state); +} + +static em_state * +new_state(void * (*alloc)(size_t), + void * (*realloc)(void *, size_t), + void (*free)(void *)) +{ + em_state *state = NULL; + + state = (*alloc)(sizeof(em_state)); + if (!state) + goto error; + + /* Stuff that might fail (used after the error label) */ + + state->trace_state = NULL; + + /* Init state ... */ + + state->alloc = alloc; + state->realloc = realloc; + state->free = free; + + state->block_table = NULL; + state->carrier_table = NULL; + + reset_mem_info(&state->info.total); + state->info.btype = NULL; + state->info.allctr = NULL; + + state->info.allctr_prv_crr = NULL; + state->info.allctr_usd_crr = NULL; + + state->info.stop_time.secs = 0; + state->info.stop_time.usecs = 0; + state->info.stop_reason = EMTP_UNDEF; + state->info.exit_status = 0; + + state->output.next_print = 0; + state->output.next_print_inc = 10; + state->output.header = NULL; + state->output.header_size = 0; + state->output.values_per_object = 0; + state->output.values_per_line = 0; + state->output.field_width = 11; + state->output.verbose = 0; + state->output.total = 0; + state->output.all_allctrs = 0; + state->output.no_allctrs = 0; + state->output.allctrs = NULL; + state->output.all_btypes = 0; + state->output.no_btypes = 0; + state->output.btypes = NULL; + state->output.max_min_values = 0; + state->output.block_counts = 0; + state->output.op_counts = 0; + state->output.lines_until_header = EM_LINES_UNTIL_HEADER; + +#if PRINT_OPERATIONS + state->output.stream = stderr; +#else + state->output.stream = stdout; +#endif + state->output.file_name = NULL; +#if EMEM_d_SWITCH + state->output.dir_name = NULL; + state->output.erl_cmd_file = NULL; + state->output.go.mutex = NULL; + state->output.go.cond = NULL; +#endif + + init_queue(state, &state->output.queue); + state->output.queue.max_buf_size = 10*1024*1024; + state->output.queue.name = "output"; + + state->trace_state = emtp_state_new(alloc, realloc, free); + if (!state->trace_state) + goto error; + + state->trace_info.version.parser.major = 0; + state->trace_info.version.parser.minor = 0; + state->trace_info.version.trace.major = 0; + state->trace_info.version.trace.minor = 0; + state->trace_info.bits = 0; + state->trace_info.max_allocator_ix = 0; + state->trace_info.allocator = NULL; + state->trace_info.max_block_type_ix = 0; + state->trace_info.block_type = NULL; + + state->input.listen_port = 0; + state->input.socket = INVALID_SOCKET; + state->input.total_trace_size = 0; + state->input.error = 0; + state->input.error_descr = NULL; + + init_queue(state, &state->input.queue); + state->input.queue.max_buf_size = 10*1024*1024; + state->input.queue.name = "input"; + + return state; + + error: + if (state) { + if (state->trace_state) + emtp_state_destroy(state->trace_state); + (*free)(state); + } + return NULL; +} + + +static emtbt_table * +mk_block_table(em_state *state) +{ + return emtbt_new_table(state->trace_info.bits == 64, + state->alloc, + state->realloc, + state->free); +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * * + * * +\* */ +#if PRINT_OPERATIONS +void print_op(em_state *state, emtp_operation *op); +#endif + +static INLINE void +update_max_values(em_mem_info *mi) +{ + if (mi->max_size < mi->size) + mi->max_size = mi->size; + if (mi->max_no < mi->no) + mi->max_no = mi->no; +} + +static INLINE void +update_min_values(em_mem_info *mi) +{ + if (mi->min_size > mi->size) + mi->min_size = mi->size; + if (mi->min_no > mi->no) + mi->min_no = mi->no; +} + +static INLINE void +update_alloc_op(em_mem_info *mi, usgnd_int_max size) +{ + mi->allocs++; + mi->size += size; + mi->no++; + update_max_values(mi); +} + +static INLINE void +update_realloc_op(em_mem_info *mi, + usgnd_int_max size, + usgnd_int_max prev_size, + int no_change) +{ + mi->reallocs++; + ASSERT(mi->size >= prev_size); + mi->size -= prev_size; + mi->size += size; + if (no_change) { + if (no_change > 0) + mi->no++; + else { + ASSERT(mi->no > 0); + mi->no--; + } + } + update_max_values(mi); + update_min_values(mi); +} + +static INLINE void +update_free_op(em_mem_info *mi, usgnd_int_max prev_size) +{ + mi->frees++; + ASSERT(mi->size >= prev_size); + mi->size -= prev_size; + ASSERT(mi->no > 0); + mi->no--; + update_min_values(mi); +} + +static int +insert_operations(em_state *state, emtp_operation ops[], size_t len) +{ + emtbt_table *crr_table; + emtbt_block old_blk; + usgnd_int_32 prev_size; + usgnd_int_max size; + size_t i; + int res; + int aix, btix, crrix; + + for (i = 0; i < len; i++) { + + while (state->output.next_print <= ops[i].time.secs) { + print_info(state, state->output.next_print, NULL); + state->output.next_print += state->output.next_print_inc; + } + + switch (ops[i].type) { + + case EMTP_ALLOC: +#if PRINT_OPERATIONS + print_op(state, &ops[i]); +#endif + btix = (int) ops[i].u.block.type; + aix = state->trace_info.block_type[btix]->allocator; + + if (!ops[i].u.block.new_ptr) + continue; + + res = emtbt_alloc_op(state->block_table, &ops[i]); + if (res != 0) + ERR_RET(res); + + size = ops[i].u.block.new_size; + + update_alloc_op(&state->info.btype[btix], size); + update_alloc_op(&state->info.allctr[aix], size); + update_alloc_op(&state->info.total, size); + break; + + case EMTP_REALLOC: { + int no; +#if PRINT_OPERATIONS + print_op(state, &ops[i]); +#endif + + res = emtbt_realloc_op(state->block_table, &ops[i], &old_blk); + if (res != 0) + ERR_RET(res); + + size = ops[i].u.block.new_size; + prev_size = old_blk.size; + + if (!ops[i].u.block.prev_ptr) + btix = (int) ops[i].u.block.type; + else + btix = (int) old_blk.type; + aix = state->trace_info.block_type[btix]->allocator; + + no = ((!old_blk.pointer && ops[i].u.block.new_ptr) + ? 1 + : ((old_blk.pointer && !ops[i].u.block.new_size) + ? -1 + : 0)); + + update_realloc_op(&state->info.btype[btix], size, prev_size, no); + update_realloc_op(&state->info.allctr[aix], size, prev_size, no); + update_realloc_op(&state->info.total, size, prev_size, no); + + break; + } + case EMTP_FREE: +#if PRINT_OPERATIONS + print_op(state, &ops[i]); +#endif + + if (!ops[i].u.block.prev_ptr) + continue; + + res = emtbt_free_op(state->block_table, &ops[i], &old_blk); + if (res != 0) + ERR_RET(res); + + prev_size = old_blk.size; + btix = (int) old_blk.type; + aix = state->trace_info.block_type[btix]->allocator; + + + update_free_op(&state->info.btype[btix], prev_size); + update_free_op(&state->info.allctr[aix], prev_size); + update_free_op(&state->info.total, prev_size); + + break; + + case EMTP_CARRIER_ALLOC: +#if PRINT_OPERATIONS + print_op(state, &ops[i]); +#endif + + aix = (int) ops[i].u.block.type; + + crrix = (int) ops[i].u.block.carrier_type; + if (!state->carrier_table[crrix]) { + state->carrier_table[crrix] = mk_block_table(state); + if (!state->carrier_table[crrix]) + ERR_RET(ENOMEM); + } + crr_table = state->carrier_table[crrix]; + + if (!ops[i].u.block.new_ptr) + continue; + + res = emtbt_alloc_op(crr_table, &ops[i]); + if (res != 0) + ERR_RET(res); + + size = ops[i].u.block.new_size; + + if (state->info.allctr_usd_crr[aix]) + update_alloc_op(state->info.allctr_usd_crr[aix], size); + if (state->info.allctr_prv_crr[crrix]) + update_alloc_op(state->info.allctr_prv_crr[crrix], size); + update_alloc_op(&state->info.allctr[crrix], size); + + break; + + case EMTP_CARRIER_REALLOC: { + int no; +#if PRINT_OPERATIONS + print_op(state, &ops[i]); +#endif + + crrix = (int) ops[i].u.block.carrier_type; + if (!state->carrier_table[crrix]) { + state->carrier_table[crrix] = mk_block_table(state); + if (!state->carrier_table[crrix]) + ERR_RET(ENOMEM); + } + crr_table = state->carrier_table[crrix]; + + res = emtbt_realloc_op(crr_table, &ops[i], &old_blk); + if (res != 0) + ERR_RET(res); + + size = ops[i].u.block.new_size; + prev_size = old_blk.size; + + if (!ops[i].u.block.prev_ptr) + aix = (int) ops[i].u.block.type; + else + aix = (int) old_blk.type; + + + no = ((!old_blk.pointer && ops[i].u.block.new_ptr) + ? 1 + : ((old_blk.pointer && !ops[i].u.block.new_size) + ? -1 + : 0)); + + if (state->info.allctr_usd_crr[aix]) + update_realloc_op(state->info.allctr_usd_crr[aix], + size, + prev_size, + no); + if (state->info.allctr_prv_crr[crrix]) + update_realloc_op(state->info.allctr_prv_crr[crrix], + size, + prev_size, + no); + update_realloc_op(&state->info.allctr[crrix], + size, + prev_size, + no); + break; + } + case EMTP_CARRIER_FREE: +#if PRINT_OPERATIONS + print_op(state, &ops[i]); +#endif + + crrix = (int) ops[i].u.block.carrier_type; + crr_table = state->carrier_table[crrix]; + if (!crr_table) + ERR_RET(EMTBT_FREE_NOBLK_ERROR); + + if (!ops[i].u.block.prev_ptr) + continue; + + res = emtbt_free_op(crr_table, &ops[i], &old_blk); + if (res != 0) + ERR_RET(res); + + prev_size = old_blk.size; + aix = (int) old_blk.type; + + if (state->info.allctr_usd_crr[aix]) + update_free_op(state->info.allctr_usd_crr[aix], prev_size); + if (state->info.allctr_prv_crr[crrix]) + update_free_op(state->info.allctr_prv_crr[crrix], prev_size); + update_free_op(&state->info.allctr[crrix], prev_size); + + break; + + case EMTP_STOP: +#if PRINT_OPERATIONS + print_op(state, &ops[i]); +#endif + state->info.stop_reason = EMTP_STOP; + state->info.stop_time.secs = ops[i].time.secs; + state->info.stop_time.usecs = ops[i].time.usecs; + print_info(state, ops[i].time.secs, NULL); + return EM_EXIT_RESULT; + case EMTP_EXIT: +#if PRINT_OPERATIONS + print_op(state, &ops[i]); +#endif + state->info.stop_reason = EMTP_EXIT; + state->info.exit_status = ops[i].u.exit_status; + state->info.stop_time.secs = ops[i].time.secs; + state->info.stop_time.usecs = ops[i].time.usecs; + print_info(state, ops[i].time.secs, NULL); + return EM_EXIT_RESULT; + default: +#if PRINT_OPERATIONS + print_op(state, &ops[i]); +#endif + /* Ignore not understood operation */ + break; + } + } + return 0; +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * * + * * +\* */ + +static const char * +error_string(int error) +{ + const char *str; + const char *error_str; + static const char unknown_error[] = "Unknown error"; + + error_str = unknown_error; + + if (error > 0) { + char *str = strerror(error); + if (str) + error_str = str; + } + else if (error < 0) { + str = emtp_error_string(error); + if (!str) { + str = emtbt_error_string(error); + if (!str) { + switch (error) { + case EM_TRUNCATED_TRACE_ERROR: + error_str = "Truncated trace"; + break; + case EM_INTERNAL_ERROR: + error_str = "emem internal error"; + break; + default: + break; + } + } + } + + if (str) + error_str = str; + } + + return error_str; +} + +static void +error(int res) +{ + error_msg(res, NULL); +} + +static void +error_msg(int res, char *msg) +{ + fprintf(stderr, + "emem: %s%sFatal error: %s (%d)\n", + msg ? msg : "", + msg ? ": ": "", + error_string(res), + res); + exit(1); +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * * + * * +\* */ + +#if EMEM_d_SWITCH + +static size_t +write_output_filename(usgnd_int_8 *ptr, + char *dirname, + char *nodename, + char *hostname, + char *datetime, + char *pid) +{ + size_t sz = 0; + usgnd_int_8 *p = ptr; + usgnd_int_8 **pp = ptr ? &p : NULL; + sz += write_str(pp, dirname); + if (pp) *((*pp)++) = DIR_SEP_CHAR; + sz++; + sz += write_str(pp, nodename); + sz += write_str(pp, "_"); + sz += write_str(pp, hostname); + sz += write_str(pp, "_"); + sz += write_str(pp, datetime); + sz += write_str(pp, "_"); + sz += write_str(pp, pid); + sz += write_str(pp, EM_OUTPUT_FILE_SUFFIX); + if (pp) *((*pp)++) = '\0'; + sz++; + return sz; +} + +static char * +make_output_filename(em_state *state) +{ + char *fname; + size_t fname_size; + char *nodename = state->trace_info.nodename; + char *hostname = state->trace_info.hostname; + char *pid = state->trace_info.pid; + char dt_buf[20]; + char *date_time = NULL; + + if (*nodename == '\0') + nodename = "nonode"; + if (*hostname == '\0') + hostname = "nohost"; + if (!state->trace_info.start_time.day) + date_time = "notime"; + else { + sprintf(dt_buf, + "%d-%2.2d-%2.2d_%2.2d.%2.2d.%2.2d", + state->trace_info.start_time.year % 10000, + state->trace_info.start_time.month % 100, + state->trace_info.start_time.day % 100, + state->trace_info.start_time.hour % 100, + state->trace_info.start_time.minute % 100, + state->trace_info.start_time.second % 100); + date_time = &dt_buf[0]; + } + if (*pid == '\0') + pid = "nopid"; + + fname = (*state->alloc)(write_output_filename(NULL, + state->output.dir_name, + nodename, + hostname, + date_time, + pid)); + if (!fname) + return NULL; + + (void) write_output_filename(fname, + state->output.dir_name, + nodename, + hostname, + date_time, + pid); + return fname; +} + +#endif + +static int +complete_state(em_state *state) +{ + int i, j, vpo, vpl; + void * (*allocp)(size_t); + void * (*reallocp)(void *, size_t); + void (*freep)(void *); + size_t size = sizeof(emtp_info); + + if (!emtp_get_info(&state->trace_info, &size, state->trace_state) + || size < sizeof(emtp_info)) + return EM_INTERNAL_ERROR; + +#if EMEM_d_SWITCH + + if (!state->output.stream) { + char *fname = make_filename(state); + mutex_lock(state->output.go.mutex); + state->output.stream = fopen(fname, "w"); + if (!state->output.stream) { + disconnect_queue_reader(&state->input.queue); + disconnect_queue_writer(&state->output.queue); + } + cond_signal(state->output.go.cond); + mutex_unlock(state->output.go.mutex); + (*state->free)((void *) fname); + if (!state->output.stream) + return EIO; + } + +#endif + + allocp = state->alloc; + reallocp = state->realloc; + freep = state->free; + + + state->carrier_table = (*allocp)((state->trace_info.max_allocator_ix+2) + * sizeof(emtbt_table *)); + if (!state->carrier_table) + return ENOMEM; + state->carrier_table++; + for (i = -1; i <= state->trace_info.max_allocator_ix; i++) + state->carrier_table[i] = NULL; + + + state->block_table = mk_block_table(state); + state->info.btype = (*allocp)((state->trace_info.max_block_type_ix+2) + * sizeof(em_mem_info)); + state->info.allctr = (*allocp)((state->trace_info.max_allocator_ix+2) + * sizeof(em_mem_info)); + if (!state->block_table || !state->info.btype || !state->info.allctr) + return ENOMEM; + + state->info.btype++; + state->info.allctr++; + + state->info.allctr_prv_crr + = (*allocp)((state->trace_info.max_allocator_ix+2) + * sizeof(em_mem_info *)); + if (!state->info.allctr_prv_crr) + return ENOMEM; + state->info.allctr_prv_crr++; + for (i = -1; i <= state->trace_info.max_allocator_ix; i++) + state->info.allctr_prv_crr[i] = NULL; + + state->info.allctr_usd_crr + = (*allocp)((state->trace_info.max_allocator_ix+2) + * sizeof(em_mem_info *)); + if (!state->info.allctr_usd_crr) + return ENOMEM; + state->info.allctr_usd_crr++; + for (i = -1; i <= state->trace_info.max_allocator_ix; i++) + state->info.allctr_usd_crr[i] = NULL; + + if (state->output.all_btypes) { + if (state->output.btypes) + (*state->free)((void *) state->output.btypes); + state->output.no_btypes = state->trace_info.max_block_type_ix + 2; + state->output.btypes = (*allocp)(state->output.no_btypes + * sizeof(em_output_types)); + if (!state->output.btypes) + return ENOMEM; + } + + if (state->output.all_allctrs) { + if (state->output.allctrs) + (*state->free)((void *) state->output.allctrs); + state->output.no_allctrs = state->trace_info.max_allocator_ix + 2; + state->output.allctrs = (*allocp)(state->output.no_allctrs + * sizeof(em_output_types)); + if (!state->output.allctrs) + return ENOMEM; + } + + for (i = -1; i <= state->trace_info.max_block_type_ix; i++) { + /* Save block type if we should print info about it */ + emtp_block_type *btp = state->trace_info.block_type[i]; + reset_mem_info(&state->info.btype[i]); + if (state->output.no_btypes) { + if (state->output.all_btypes) { + state->output.btypes[i+1].name = btp->name; + state->output.btypes[i+1].ix = btp->valid ? i : -1; + } + else { + for (j = 0; j < state->output.no_btypes; j++) + if (strcmp(btp->name, state->output.btypes[j].name) == 0) { + state->output.btypes[j].ix = i; + break; + } + } + } + } + + /* Remove invalid block types */ + if (state->output.no_btypes) { + for (i = 0, j = 0; i < state->output.no_btypes; i++) { + if (state->output.btypes[i].ix >= 0) { + state->output.btypes[j].name = state->output.btypes[i].name; + state->output.btypes[j].ix = state->output.btypes[i].ix; + j++; + } + } + state->output.no_btypes = j; + } + + for (i = -1; i <= state->trace_info.max_allocator_ix; i++) { + /* Save allocator if we should print info about it */ + emtp_allocator *ap = state->trace_info.allocator[i]; + reset_mem_info(&state->info.allctr[i]); + if (state->output.no_allctrs) { + if (state->output.all_allctrs) { + state->output.allctrs[i+1].name = ap->name; + state->output.allctrs[i+1].ix = ap->valid ? i : -1; + } + else { + for (j = 0; j < state->output.no_allctrs; j++) + if (strcmp(ap->name, state->output.allctrs[j].name) == 0) { + state->output.allctrs[j].ix = i; + break; + } + } + } + + /* Allocate em_mem_info if used carrier info is available */ + if (ap->flags & EMTP_ALLOCATOR_FLAG_HAVE_USED_CARRIERS_INFO + || (i == state->trace_info.segment_ix + && state->trace_info.have_segment_carrier_info)) { + state->info.allctr_usd_crr[i] + = (em_mem_info *) (*allocp)(sizeof(em_mem_info)); + if (!state->info.allctr_usd_crr[i]) + return ENOMEM; + reset_mem_info(state->info.allctr_usd_crr[i]); + } + + /* Allocate em_mem_info for carrier providers */ + if (ap->carrier.provider) { + sgnd_int_32 j; + for (j = 0; j < ap->carrier.no_providers; j++) { + sgnd_int_32 crr_prvdr = ap->carrier.provider[j]; + if (!state->info.allctr_prv_crr[crr_prvdr]) { + state->info.allctr_prv_crr[crr_prvdr] + = (em_mem_info *) (*allocp)(sizeof(em_mem_info)); + if (!state->info.allctr_prv_crr[crr_prvdr]) + return ENOMEM; + reset_mem_info(state->info.allctr_prv_crr[crr_prvdr]); + } + } + } + } + + /* Remove invalid allocators */ + if (state->output.no_allctrs) { + for (i = 0, j = 0; i < state->output.no_allctrs; i++) { + if (state->output.allctrs[i].ix >= 0) { + state->output.allctrs[j].name = state->output.allctrs[i].name; + state->output.allctrs[j].ix = state->output.allctrs[i].ix; + j++; + } + } + state->output.no_allctrs = j; + } + + if (state->output.no_btypes) { + state->output.btypes = (*reallocp)(state->output.btypes, + sizeof(em_output_types) + * state->output.no_btypes); + if (!state->output.btypes) + return ENOMEM; + } + + if (state->output.no_allctrs) { + state->output.allctrs = (*reallocp)(state->output.allctrs, + sizeof(em_output_types) + * state->output.no_allctrs); + if (!state->output.allctrs) + return ENOMEM; + } + + + vpo = 1; + if (state->output.max_min_values) + vpo += 2; + if (state->output.block_counts) { + vpo++; + if (state->output.max_min_values) + vpo += 2; + } + if (state->output.op_counts) + vpo += 3; + + state->output.values_per_object = vpo; + + vpl = 0; + vpl++; /* time */ + if (state->output.total) { + vpl += vpo; /* total allocated */ + if (state->trace_info.have_segment_carrier_info) { + vpl += vpo; /* total carriers */ + vpl += vpo; /* cached carriers */ + } + } + for (i = 0; i < state->output.no_allctrs; i++) { + vpl += vpo; /* allocated */ + if (state->trace_info.have_carrier_info) { + if (state->info.allctr_prv_crr[state->output.allctrs[i].ix]) + vpl += vpo; /* provided carriers */ + vpl += vpo; /* used carriers */ + } + } + vpl += state->output.no_btypes*vpo; /* allocated */ + + state->output.values_per_line = vpl; + + state->output.header_size = write_header(state, NULL, 1); + state->output.header = (*state->alloc)(state->output.header_size + 1); + if (!state->output.header) + return ENOMEM; + size = write_header(state, state->output.header, 1); + ASSERT(state->output.header_size == size); + return 0; +} + +static int +process_trace(em_state *state) +{ + emtp_operation ops[EM_NO_OF_OPS]; + int res; + size_t ops_len; + em_area area; + + while (1) { + get_next_read_area(&area, state, &state->input.queue); + if (!area.size) + return EM_TRUNCATED_TRACE_ERROR; + res = emtp_parse(state->trace_state, + &area.ptr, &area.size, + NULL, 0, NULL); + if (res == EMTP_HEADER_PARSED) + break; + if (res == EMTP_NEED_MORE_TRACE) + continue; + + if (res < 0) + return res; + else + return EM_TRUNCATED_TRACE_ERROR; + } + + res = complete_state(state); + if (res != 0) + return res; + + print_main_header(state); + + while (1) { + if (!area.size) { + get_next_read_area(&area, state, &state->input.queue); + if (!area.size) + return EM_TRUNCATED_TRACE_ERROR; + + } + + + while (area.size) { + ops_len = EM_NO_OF_OPS; + res = emtp_parse(state->trace_state, + &area.ptr, &area.size, + ops, sizeof(emtp_operation), &ops_len); + if (res < 0) + return res; + + res = insert_operations(state, ops, ops_len); + if (res != 0) + return res; + + } + + } + +} + +static void +usage(char *sw, char *error) +{ + int status = 0; + FILE *filep = stdout; +#ifdef __WIN32__ +#define SW_CHAR "/" +#else +#define SW_CHAR "-" +#endif + + if (error) { + ASSERT(sw); + status = 1; + filep = stderr; + fprintf(filep, "emem: %s: %s\n", sw, error); + } + fprintf(filep, + "Usage: emem " +#if EMEM_A_SWITCH + "[" SW_CHAR "A ] " +#endif + "[" SW_CHAR "a ] " + "[" SW_CHAR "b ] " +#if EMEM_C_SWITCH + "[" SW_CHAR "C ] " +#endif +#if EMEM_c_SWITCH + "[" SW_CHAR "c ] " +#endif + "{" +#if EMEM_d_SWITCH + SW_CHAR "d |" +#endif + SW_CHAR "f } " + "[" SW_CHAR "h] " + "[" SW_CHAR "i ] " + "[" SW_CHAR "m] " + "[" SW_CHAR "n] " + "[" SW_CHAR "o] " + "{" SW_CHAR "p } " + "[" SW_CHAR "t] " + "[" SW_CHAR "v] " + "\n"); + if (error) + exit(1); + else { + char *help_str = + "\n" + " [] - switch is allowed any number of times\n" + " {} - switch is allowed at most one time\n" +#if EMEM_d_SWITCH + " | - exclusive or\n" +#endif + "\n" + " Switches:\n" +#if EMEM_A_SWITCH + " " SW_CHAR "a - display info about Allocator and all block types using \n" +#endif + " " SW_CHAR "a - display info about allocator \n" + " " SW_CHAR "b - display info about block type \n" +#if EMEM_C_SWITCH + " " SW_CHAR "C - display info about class and all block types in class \n" +#endif +#if EMEM_c_SWITCH + " " SW_CHAR "b - display info about class \n" +#endif +#if EMEM_d_SWITCH + " " SW_CHAR "d - run as daemon and set output directory to \n" +#endif + " " SW_CHAR "f - set output file to \n" + " " SW_CHAR "h - display help and exit\n" + " " SW_CHAR "i - set display interval to seconds\n" + " " SW_CHAR "m - display max/min values\n" + " " SW_CHAR "n - display block/carrier/segment count values\n" + " " SW_CHAR "o - display operation count values\n" + " " SW_CHAR "p

- set listen port to

\n" + " " SW_CHAR "t - display info about total values\n" + " " SW_CHAR "v - verbose output\n"; + fprintf(filep, help_str); + exit(0); + } + +#undef SW_CHAR +} + + +static void +parse_args(em_state *state, int argc, char *argv[]) +{ + int port; + int i; + + port = -1; + + i = 1; + while (i < argc) { + if ((argv[i][0] != '-' && argv[i][0] != '/') || argv[i][2] != '\0') { + unknown_switch: + usage(argv[i], "unknown switch"); + } + + switch (argv[i][1]) { +#if EMEM_A_SWITCH + case 'A': /* TODO: Allocator + blocktypes using allocator */ +#endif + case 'a': + if (i + 1 >= argc) + usage(argv[i], "missing allocator"); + i++; + if (state->output.all_allctrs || strcmp(argv[i],"all") == 0) { + state->output.all_allctrs = 1; + break; + } + + if (!state->output.allctrs) + state->output.allctrs + = (*state->alloc)(sizeof(em_output_types)*argc/2); + if (!state->output.allctrs) + error(ENOMEM); + state->output.allctrs[state->output.no_allctrs].name = argv[i]; + state->output.allctrs[state->output.no_allctrs].ix = -1; + state->output.no_allctrs++; + break; + case 'b': + if (i + 1 >= argc) + usage(argv[i], "missing block type"); + i++; + if (state->output.all_btypes || strcmp(argv[i],"all") == 0) { + state->output.all_btypes = 1; + break; + } + + if (!state->output.btypes) + state->output.btypes + = (*state->alloc)(sizeof(em_output_types)*argc/2); + if (!state->output.btypes) + error(ENOMEM); + state->output.btypes[state->output.no_btypes].name = argv[i]; + state->output.btypes[state->output.no_btypes].ix = -1; + state->output.no_btypes++; + break; +#if EMEM_C_SWITCH +#endif +#if EMEM_c_SWITCH + case 'c': + break; +#endif +#if EMEM_d_SWITCH + case 'd': { + char *p; + char *fname; + if (state->output.dir_name) + usage(argv[i], "directory already set"); + if (state->output.file_name) + usage(argv[i], "file name already set"); + if (i + 1 >= argc) + usage(argv[i], "missing directory name"); + state->output.dir_name = argv[i+1]; + fname = (*state->alloc)(strlen(state->output.dir_name) + + 1 + + strlen(EM_ERL_CMD_FILE_NAME) + + 1); + state->output.go.mutex = (*state->alloc)(sizeof(ethr_mutex)); + state->output.go.cond = (*state->alloc)(sizeof(ethr_cond)); + if (!fname || !state->output.go.mutex || !state->output.go.cond) + error(ENOMEM); + p = fname; + (void) write_str(&p, state->output.dir_name); + *(p++) = DIR_SEP_CHAR; + (void) write_str(&p, EM_ERL_CMD_FILE_NAME); + *(p++) = '\0'; + state->output.erl_cmd_file = fopen(fname, "w"); + if (!state->output.erl_cmd_file) + usage(argv[i], "cannot create files in directory"); + (*state->free)((void *) fname); + state->output.stream = NULL; + mutex_init(state->output.go.mutex); + cond_init(state->output.go.cond); + i++; + break; + } +#endif + case 'f': +#if EMEM_d_SWITCH + if (state->output.dir_name) + usage(argv[i], "directory already set"); +#endif + if (state->output.file_name) + usage(argv[i], "file name already set"); + if (i + 1 >= argc) + usage(argv[i], "missing file name"); + state->output.file_name = argv[i+1]; + state->output.stream = fopen(state->output.file_name, "w"); + if (!state->output.stream) + usage(argv[i], "cannot create file"); + if (setvbuf(state->output.stream, NULL, _IONBF, 0) != 0) { + fprintf(stderr, + "emem: failed to set file %s in unbuffered mode\n", + state->output.file_name); + exit(1); + } + i++; + break; + case 'h': + usage(NULL, NULL); + break; + case 'i': { + int interval; + if (argv[i][2]) + goto unknown_switch; + + if (i + 1 >= argc) + usage(argv[i], "missing interval"); + interval = atoi(argv[i+1]); + if (interval < 1) + usage(argv[i], "bad interval"); + i++; + state->output.next_print_inc = interval; + break; + } + case 'm': + state->output.max_min_values = 1; + break; + case 'n': + state->output.block_counts = 1; + break; + case 'o': + state->output.op_counts = 1; + break; + case 'p': + if (state->input.listen_port) + usage(argv[i], "port already set"); + if (i + 1 >= argc) + usage(argv[i], "missing port number"); + port = atoi(argv[i+1]); + if (port <= 1024 || port >= (1 << 16)) + usage(argv[i], "bad port number"); + i++; + state->input.listen_port = (usgnd_int_16) port; + break; + case 't': + state->output.total = 1; + break; + case 'v': + state->output.verbose = 1; + break; + default: + goto unknown_switch; + } + i++; + } + + if (!state->output.allctrs && !state->output.btypes) + state->output.total = 1; +} + +static int +init_connection(em_state *state) +{ + int res; + SOCKET lsock; + SOCKET sock = INVALID_SOCKET; + struct sockaddr_in my_addr; + int oth_addr_len; + struct sockaddr_in oth_addr; +#ifdef __WIN32__ + WORD wVersionRequested = MAKEWORD(2,0); + WSADATA wsaData; + + if (WSAStartup(wVersionRequested, &wsaData) != 0) + return EIO; + + if ((LOBYTE(wsaData.wVersion) != 2) || (HIBYTE(wsaData.wVersion) != 0)) + return EIO; +#endif + + do_socket: + sock = socket(AF_INET, SOCK_STREAM, 0); + if (IS_INVALID_SOCKET(sock)) { + res = GET_SOCK_ERRNO(); + if (res == EINTR) + goto do_socket; + goto error; + } + + memset((void *) &my_addr, 0, sizeof(struct sockaddr_in)); + + my_addr.sin_family = AF_INET; + my_addr.sin_addr.s_addr = htonl(INADDR_ANY); + my_addr.sin_port = htons(state->input.listen_port); + + do_bind: + if (bind(sock, (struct sockaddr*) &my_addr, sizeof(my_addr)) < 0) { + res = GET_SOCK_ERRNO(); + if (res == EINTR) + goto do_bind; + goto error; + } + + do_listen: + if (listen(sock, 1) < 0) { + res = GET_SOCK_ERRNO(); + if (res == EINTR) + goto do_listen; + goto error; + } + + lsock = sock; + state->input.socket = sock; + + res = print_emu_arg(state); + if (res != 0) + goto error; + + print_string(state, "> Waiting for emulator to connect... "); + + do_accept: + oth_addr_len = sizeof(oth_addr); + sock = accept(lsock, (struct sockaddr *) &oth_addr, &oth_addr_len); + if (IS_INVALID_SOCKET(sock)) { + res = GET_SOCK_ERRNO(); + if (res == EINTR) + goto do_accept; + sock = lsock; + goto error; + } + + print_string(state, "connected\n"); + + closesocket(lsock); + state->input.socket = sock; + + return 0; + + error: + if (!IS_INVALID_SOCKET(sock)) { + closesocket(sock); + state->input.socket = INVALID_SOCKET; + } + return res; +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * IO threads * + * * +\* */ + +/* + * The input thread reads from a socket and puts the received data + * in the input buffer queue. + * + * Note: There is intentionally no flow control. If the emem program + * cannot process data as fast as it arrives, it is supposed + * to crash when hitting the maximum buffersize; otherwise, + * the traced emulator would be slowed down. + */ +static void * +input_thread_func(void *arg) +{ + int res; + char *edescr = NULL; + ssize_t recv_sz; + usgnd_int_max total_trace_size = 0; + em_state *state = (em_state *) arg; + em_area area = {NULL, 0}; + SOCKET sock = state->input.socket; + em_buf_queue *queue = &state->input.queue; + + while(1) { + get_next_write_area(&area, + state, + queue, + EM_MIN_TRACE_READ_SIZE); + + if (!area.ptr) { + res = ENOMEM; + edescr = "Input alloc"; + goto stop; + } + + do_recv: + if (is_queue_reader_disconnected(queue)) { + res = 0; + edescr = "Input"; + goto stop; + } + recv_sz = recv(sock, (void *) area.ptr, area.size, 0); + if (recv_sz <= 0) { + res = GET_SOCK_ERRNO(); + if (res == EINTR) + goto do_recv; + edescr = "Input recv"; + goto stop; + } + area.size = (size_t) recv_sz; + total_trace_size += (usgnd_int_max) recv_sz; + } + + stop: + state->input.error = res; + state->input.error_descr = edescr; + state->input.total_trace_size = total_trace_size; + disconnect_queue_writer(queue); + if (!IS_INVALID_SOCKET(state->input.socket)) { + closesocket(sock); + state->input.socket = INVALID_SOCKET; + } + return NULL; +} + + +static void * +output_thread_func(void *arg) +{ + em_state *state = (em_state *) arg; + em_area area = {NULL, 0}; + +#if EMEM_d_SWITCH + + if (state->output.go.mutex) { + mutex_lock(state->output.go.mutex); + while (!state->output.stream + && !is_queue_writer_disconnected(&state->output.queue)) + cond_wait(state->output.go.cond, state->output.go.mutex); + mutex_unlock(state->output.go.mutex); + + mutex_destroy(state->output.go.mutex); + (*state->free)((void *) state->output.go.mutex); + state->output.go.mutex = NULL; + cond_destroy(state->output.go.cond); + (*state->free)((void *) state->output.go.cond); + state->output.go.cond = NULL; + } + +#endif + + while (1) { + get_next_read_area(&area, state, &state->output.queue); + if (!area.size) { + disconnect_queue_reader(&state->output.queue); + if (is_queue_writer_disconnected(&state->output.queue)) + goto stop; + else + error_msg(EIO, "Output queue"); + } + if (fwrite((void *) area.ptr, + sizeof(usgnd_int_8), + area.size, + state->output.stream) != area.size) { + disconnect_queue_reader(&state->output.queue); + error_msg(0, "Write"); + } + } + + stop: + if (state->output.stream != stdout && state->output.stream != stderr) + fclose(state->output.stream); + return NULL; +} + + +int +main(int argc, char *argv[]) +{ + int res, ires, jres; + ethr_tid input_tid; + ethr_tid output_tid; + em_state *state; + + /* set stdout in unbuffered mode */ + if (setvbuf(stdout, NULL, _IONBF, 0) != 0) { + fprintf(stderr, "emem: failed to set stdout in unbuffered mode\n"); + exit(1); + } + + if (ethr_init(NULL) != 0) { + fprintf(stderr, "emem: failed to initialize thread package\n"); + exit(1); + } + + state = new_state(malloc, realloc, free); + if (!state) + error(ENOMEM); + + parse_args(state, argc, argv); + + res = ethr_thr_create(&output_tid, + output_thread_func, + (void *) state, + NULL); + if (res != 0) + error_msg(res, "Output thread create"); + +#ifdef DEBUG + print_string(state, "> [debug]\n"); +#endif +#ifdef PURIFY + print_string(state, "> [purify]\n"); +#endif +#ifdef QUANTIFY + print_string(state, "> [quantify]\n"); +#endif +#ifdef PURECOV + print_string(state, "> [purecov]\n"); +#endif + + res = init_connection(state); + if (res != 0) + error_msg(res, "Initialize connection"); + + res = ethr_thr_create(&input_tid, + input_thread_func, + (void *) state, + NULL); + if (res != 0) + error_msg(res, "Input thread create"); + + res = process_trace(state); + + disconnect_queue_reader(&state->input.queue); + + jres = ethr_thr_join(input_tid, NULL); + if (jres != 0) + error_msg(jres, "Input thread join"); + + if (res == EM_EXIT_RESULT) + print_main_footer(state); + disconnect_queue_writer(&state->output.queue); + + jres = ethr_thr_join(output_tid, NULL); + if (jres != 0) + error_msg(jres, "Output thread join"); + + ires = state->input.error; + + destroy_state(state); + +#ifdef __WIN32__ + WSACleanup(); +#endif + + switch (res) { + case EM_EXIT_RESULT: + res = 0; + break; + case EM_TRUNCATED_TRACE_ERROR: + error_msg(ires, state->input.error_descr); + break; + default: + error(res); + break; + } + + return 0; +} + + +#if PRINT_OPERATIONS +void +print_op(em_state *state, emtp_operation *op) +{ + +#if 0 + printf("%5" USGND_INT_32_FSTR ":%6.6" USGND_INT_32_FSTR " ", + op->time.secs, op->time.usecs); +#endif + if (state->trace_info.version.parser.major >= 2) { + + switch (op->type) { + case EMTP_ALLOC: + printf(" %" USGND_INT_MAX_FSTR " = alloc(%" USGND_INT_16_FSTR + ", %" USGND_INT_MAX_FSTR ")\n", + op->u.block.new_ptr, + op->u.block.type, + op->u.block.new_size); + break; + case EMTP_REALLOC: + printf(" %" USGND_INT_MAX_FSTR " = realloc(%" USGND_INT_16_FSTR + ", %" USGND_INT_MAX_FSTR ", %" USGND_INT_MAX_FSTR ")\n", + op->u.block.new_ptr, + op->u.block.type, + op->u.block.prev_ptr, + op->u.block.new_size); + break; + case EMTP_FREE: + printf(" free(%" USGND_INT_16_FSTR ", %" USGND_INT_MAX_FSTR ")" + "\n", + op->u.block.type, + op->u.block.prev_ptr); + break; + case EMTP_CARRIER_ALLOC: + printf(" %" USGND_INT_MAX_FSTR " = carrier_alloc(%" + USGND_INT_16_FSTR ", %" USGND_INT_16_FSTR ", %" + USGND_INT_MAX_FSTR ")\n", + op->u.block.new_ptr, + op->u.block.carrier_type, + op->u.block.type, + op->u.block.new_size); + break; + case EMTP_CARRIER_REALLOC: + printf(" %" USGND_INT_MAX_FSTR " = carrier_realloc(%" + USGND_INT_16_FSTR ", %" USGND_INT_16_FSTR ", %" + USGND_INT_MAX_FSTR ", %" USGND_INT_MAX_FSTR ")\n", + op->u.block.new_ptr, + op->u.block.carrier_type, + op->u.block.type, + op->u.block.prev_ptr, + op->u.block.new_size); + case EMTP_CARRIER_FREE: + printf(" carrier_free(%" USGND_INT_16_FSTR ", %" USGND_INT_16_FSTR + ", %" USGND_INT_MAX_FSTR ")\n", + op->u.block.carrier_type, + op->u.block.type, + op->u.block.prev_ptr); + break; + default: + printf(" op = %d\n", op->type); + break; + } + + } + else { + + switch (op->type) { + case EMTP_ALLOC: + printf(" %" USGND_INT_MAX_FSTR " = alloc(%" USGND_INT_MAX_FSTR ")" + "\n", + op->u.block.new_ptr, + op->u.block.new_size); + break; + case EMTP_REALLOC: + printf(" %" USGND_INT_MAX_FSTR " = realloc(%" USGND_INT_MAX_FSTR + ", %" USGND_INT_MAX_FSTR ")\n", + op->u.block.new_ptr, + op->u.block.prev_ptr, + op->u.block.new_size); + break; + case EMTP_FREE: + printf(" free(%" USGND_INT_MAX_FSTR ")\n", + op->u.block.prev_ptr); + break; + default: + printf(" op = %d\n", op->type); + break; + } + } + fflush(stdout); +} +#endif diff --git a/lib/tools/c_src/erl_memory_trace_block_table.c b/lib/tools/c_src/erl_memory_trace_block_table.c new file mode 100644 index 0000000000..9c19358f14 --- /dev/null +++ b/lib/tools/c_src/erl_memory_trace_block_table.c @@ -0,0 +1,761 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance 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$ + */ + + +/* + * Description: + * + * Author: Rickard Green + */ + +/* Headers to include ... */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "erl_memory_trace_block_table.h" +#include + +#undef HARD_DEBUG +#undef REALLY_HARD_DEBUG +#ifdef DEBUG +# define HARD_DEBUG 0 +# define REALLY_HARD_DEBUG 0 +#else +# define HARD_DEBUG 0 +# define REALLY_HARD_DEBUG 0 +#endif + +/* Some system specific defines ... */ +#if defined(__WIN32__) && !defined(__GNUC__) +# define INLINE __forceinline +#else +# ifdef __GNUC__ +# define INLINE __inline__ +# else +# define INLINE +# endif +#endif + +/* Our own assert() ... */ +#ifdef DEBUG +#define ASSERT(A) ((void) ((A) ? 1 : assert_failed(__FILE__, __LINE__, #A))) +#include +static int assert_failed(char *f, int l, char *a) +{ + fprintf(stderr, "%s:%d: Assertion failed: %s\n", f, l, a); + abort(); + return 0; +} + +#else +#define ASSERT(A) ((void) 1) +#endif + + +#define EMTBT_BLOCKS_PER_POOL 1000 + +typedef struct emtbt_block_pool_ { + struct emtbt_block_pool_ *next; + emtbt_block blocks[1]; +} emtbt_block_pool; + +struct emtbt_table_ { + void * (*alloc)(size_t); + void * (*realloc)(void *, size_t); + void (*free)(void *); + int is_64_bit; + int no_blocks; + int no_of_buckets; + int max_used_buckets; + int min_used_buckets; + int used_buckets; + int current_size_index; + emtbt_block *blocks; + emtbt_block ** buckets; + + + /* Fixed size allocation of blocks */ + emtbt_block_pool *block_pools; + emtbt_block *free_blocks; + int blocks_per_pool; + +}; + + +static emtbt_block null_blk = {0}; + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Block table * + * * +\* */ + +#if HARD_DEBUG +static void check_table(emtbt_table *table); +#endif + +static emtbt_block * +block_alloc_new_pool(emtbt_table *tab) +{ + size_t size; + emtbt_block_pool *poolp; + + size = sizeof(emtbt_block_pool) - sizeof(emtbt_block); + size += tab->blocks_per_pool*sizeof(emtbt_block); + + poolp = (*tab->alloc)(size); + + if (poolp) { + int i; + emtbt_block *blks; + + poolp->next = tab->block_pools; + tab->block_pools = poolp; + + blks = (emtbt_block *) poolp->blocks; + + for (i = 1; i < tab->blocks_per_pool - 1; i++) + blks[i].next = &blks[i + 1]; + blks[tab->blocks_per_pool - 1].next = NULL; + tab->free_blocks = &blks[1]; + + return &blks[0]; + } + return NULL; +} + +static INLINE emtbt_block * +block_alloc(emtbt_table *tab) +{ + emtbt_block *res; +#if HARD_DEBUG + check_table(tab); +#endif + + if (tab->free_blocks) { + res = tab->free_blocks; + tab->free_blocks = tab->free_blocks->next; + } + else { + res = block_alloc_new_pool(tab); + } + +#ifdef DEBUG + res->next = ((emtbt_block *) 0xfffffff0); + res->prev = ((emtbt_block *) 0xfffffff0); + res->bucket = ((emtbt_block **) 0xfffffff0); +#endif + +#if HARD_DEBUG + check_table(tab); +#endif + + return res; +} + +static INLINE void +block_free(emtbt_table *tab, emtbt_block *bp) +{ + +#if HARD_DEBUG + check_table(tab); +#endif + + bp->next = tab->free_blocks; + tab->free_blocks = bp; + +#if HARD_DEBUG + check_table(tab); +#endif + + +} + +#define PRIME0 ((usgnd_int_32) 268438039) +#define PRIME1 ((usgnd_int_32) 268440479) +#define PRIME2 ((usgnd_int_32) 268439161) +#define PRIME3 ((usgnd_int_32) 268437017) + +#define MK_HASH(H, P, IS64) \ +do { \ + (H) = (P) & 0xff; \ + (H) *= PRIME0; \ + (H) += ((P) >> 8) & 0xff; \ + (H) *= PRIME1; \ + (H) += ((P) >> 16) & 0xff; \ + (H) *= PRIME2; \ + (H) += ((P) >> 24) & 0xff; \ + (H) *= PRIME3; \ + if ((IS64)) { \ + (H) += ((P) >> 32) & 0xff; \ + (H) *= PRIME0; \ + (H) += ((P) >> 40) & 0xff; \ + (H) *= PRIME1; \ + (H) += ((P) >> 48) & 0xff; \ + (H) *= PRIME2; \ + (H) += ((P) >> 56) & 0xff; \ + (H) *= PRIME3; \ + } \ +} while (0) + +static const int table_sizes[] = { + 3203, + 4813, + 6421, + 9643, + 12853, + 19289, + 25717, + 51437, + 102877, + 205759, + 411527, + 823117, + 1646237, + 3292489, + 6584983, + 13169977, + 26339969, + 52679969 +}; + +#if HARD_DEBUG + +static void +check_table(emtbt_table *table) +{ + int no_blocks; + emtbt_block *block, *prev_block; + + no_blocks = 0; + block = table->blocks; + ASSERT(!block || !block->prev); + prev_block = NULL; + while (block) { + usgnd_int_32 hash; + MK_HASH(hash, block->pointer, table->is_64_bit); + ASSERT(hash == block->hash); + ASSERT(block->bucket - table->buckets + == hash % table->no_of_buckets); + ASSERT(!prev_block || prev_block == block->prev); + prev_block = block; + block = block->next; + no_blocks++; + ASSERT(table->no_blocks >= no_blocks); + } + + ASSERT(table->no_blocks == no_blocks); + +#if REALLY_HARD_DEBUG + { + int i; + for (i = 0; i < table->no_of_buckets; i++) { + int bucket_end_found; + emtbt_block **bucket; + if (!table->buckets[i]) + continue; + bucket_end_found = 0; + bucket = &table->buckets[i]; + for (block = table->blocks; block; block = block->next) { + if (block->bucket == bucket) { + if (!block->prev || block->prev->bucket != bucket) + ASSERT(*bucket == block); + if (!block->next || block->next->bucket != bucket) + bucket_end_found++; + } + } + ASSERT(bucket_end_found); + } + } +#endif + +} + +#endif + +static INLINE void +link_block(emtbt_table *table, emtbt_block **bucket, emtbt_block *block) +{ + ASSERT(bucket); + + block->bucket = bucket; + if (*bucket) { + block->next = *bucket; + block->prev = (*bucket)->prev; + if (block->prev) + block->prev->next = block; + else + table->blocks = block; + block->next->prev = block; + } + else { + block->next = table->blocks; + block->prev = NULL; + if (table->blocks) + table->blocks->prev = block; + table->blocks = block; + table->used_buckets++; + + } + *bucket = block; + table->no_blocks++; + +#if HARD_DEBUG + check_table(table); +#endif + +} + +static int +resize_table(emtbt_table *table, int new_no_of_buckets) +{ +#ifdef DEBUG + int org_no_blocks; +#endif + int i; + emtbt_block *block; + emtbt_block **buckets; + + if (new_no_of_buckets < table->no_of_buckets) { + /* shrink never fails */ + buckets = (emtbt_block **) (*table->realloc)(table->buckets, + (sizeof(emtbt_block *) + * new_no_of_buckets)); + if (!buckets) + return 1; + } + else if (new_no_of_buckets > table->no_of_buckets) { + (*table->free)((void *) table->buckets); + buckets = (emtbt_block **) (*table->alloc)((sizeof(emtbt_block *) + * new_no_of_buckets)); + if (!buckets) + return 0; + } + else + return 1; + + table->buckets = buckets; + table->no_of_buckets = new_no_of_buckets; + table->max_used_buckets = (4*new_no_of_buckets)/5; + table->min_used_buckets = new_no_of_buckets/5; + table->used_buckets = 0; + +#ifdef DEBUG + org_no_blocks = table->no_blocks; +#endif + + table->no_blocks = 0; + + + for (i = 0; i < new_no_of_buckets; i++) + buckets[i] = NULL; + + block = table->blocks; + table->blocks = NULL; + + while (block) { + emtbt_block *next_block = block->next; + link_block(table,&table->buckets[block->hash%new_no_of_buckets],block); + block = next_block; + } + + ASSERT(org_no_blocks == table->no_blocks); + + return 1; +} + +static INLINE int +grow_table(emtbt_table *table) +{ + if (table->current_size_index < sizeof(table_sizes)/sizeof(int)) { + int new_size; + table->current_size_index++; + new_size = table_sizes[table->current_size_index]; + ASSERT(new_size > 0); + return resize_table(table, new_size); + } + return 1; +} + +static INLINE void +shrink_table(emtbt_table *table) +{ + if (table->current_size_index > 0) { + int new_size; + table->current_size_index--; + new_size = table_sizes[table->current_size_index]; + ASSERT(new_size > 0); + (void) resize_table(table, new_size); + } +} + +static INLINE emtbt_block * +peek_block(emtbt_table *table, usgnd_int_max ptr) +{ + emtbt_block **bucket; + emtbt_block *block; + usgnd_int_32 hash; + + MK_HASH(hash, ptr, table->is_64_bit); + + bucket = &table->buckets[hash % table->no_of_buckets]; + block = *bucket; + if (!block) + return NULL; + + while (block->bucket == bucket) { + ASSERT(block); + if (block->pointer == ptr) + return block; + if (!block->next) + break; + block = block->next; + } + return NULL; +} + +static INLINE int +insert_block(emtbt_table *table, emtbt_block *block) +{ + emtbt_block **bucket; + emtbt_block *tmp_block; + usgnd_int_32 hash; + usgnd_int_max p; + +#if HARD_DEBUG + check_table(table); +#endif + + if (table->used_buckets >= table->max_used_buckets) { + if(!grow_table(table)) + return -1; + } + + p = block->pointer; + + MK_HASH(hash, p, table->is_64_bit); + block->hash = hash; + + bucket = &table->buckets[hash % table->no_of_buckets]; + tmp_block = *bucket; + if (tmp_block) { + while (tmp_block->bucket == bucket) { + if (tmp_block->pointer == p) + return 0; + if (!tmp_block->next) + break; + tmp_block = tmp_block->next; + } + } + + link_block(table, bucket, block); + + ASSERT(block == peek_block(table, p)); + + + return 1; +} + +static INLINE void +delete_block(emtbt_table *table, emtbt_block *block) +{ + emtbt_block **bucket; + + if (!block) + return; + +#if HARD_DEBUG + check_table(table); +#endif + + bucket = block->bucket; + ASSERT(bucket); + + if (block->prev) + block->prev->next = block->next; + else + table->blocks = block->next; + + if (block->next) + block->next->prev = block->prev; + + if (block == *bucket) { + ASSERT(!block->prev || block->prev->bucket != bucket); + if (block->next && block->next->bucket == bucket) + *bucket = block->next; + else { + ASSERT(table->used_buckets > 0); + *bucket = NULL; + table->used_buckets--; + } + } +#ifdef DEBUG + + block->next = ((emtbt_block *) 0xfffffff0); + block->prev = ((emtbt_block *) 0xfffffff0); + block->bucket = ((emtbt_block **) 0xfffffff0); +#endif + + ASSERT(table->no_blocks > 0); + table->no_blocks--; + + if (table->used_buckets < table->min_used_buckets) + shrink_table(table); + +#if HARD_DEBUG + check_table(table); +#endif + +} + +static INLINE emtbt_block * +fetch_block(emtbt_table *table, usgnd_int_max ptr) +{ + emtbt_block *block; + + block = peek_block(table, ptr); + delete_block(table, block); + return block; +} + + +const char *emtbt_error_string(int error) +{ + switch (error) { + case EMTBT_ALLOC_XBLK_ERROR: + return "Allocation to an already existing block"; + case EMTBT_REALLOC_NOBLK_ERROR: + return "Reallocation of non-existing block"; + case EMTBT_REALLOC_XBLK_ERROR: + return "Reallocation to an already existing block"; + case EMTBT_REALLOC_BLK_TYPE_MISMATCH: + return "Block types mismatch when reallocating"; + case EMTBT_FREE_NOBLK_ERROR: + return "Deallocation of non-existing block"; + case EMTBT_FREE_BLK_TYPE_MISMATCH: + return "Block types mismatch when deallocating"; + case EMTBT_INTERNAL_ERROR: + return "Block table internal error"; + default: + return NULL; + } + + +} + + +emtbt_table * +emtbt_new_table(int is_64_bit, + void * (*alloc)(size_t), + void * (*realloc)(void *, size_t), + void (*free)(void *)) +{ + emtbt_table *tab = (*alloc)(sizeof(emtbt_table)); + if (tab) { + tab->alloc = alloc; + tab->realloc = realloc; + tab->free = free; + tab->is_64_bit = is_64_bit; + tab->no_blocks = 0; + tab->no_of_buckets = 0; + tab->max_used_buckets = 0; + tab->min_used_buckets = 0; + tab->used_buckets = 0; + tab->current_size_index = 0; + tab->blocks = NULL; + tab->buckets = NULL; + + tab->block_pools = NULL; + tab->free_blocks = NULL; + tab->blocks_per_pool = EMTBT_BLOCKS_PER_POOL; + + } + return tab; +} + +void +emtbt_destroy_table(emtbt_table *tab) +{ + void (*freep)(void *); + emtbt_block_pool *poolp1, *poolp2; + + freep = tab->free; + + /* Free block pools */ + poolp1 = tab->block_pools; + while (poolp1) { + poolp2 = poolp1; + poolp1 = poolp1->next; + (*freep)((void *) poolp2); + } + + if (tab->buckets) + (*freep)((void *) tab->buckets); + + (*freep)((void *) tab); +} + + +#define CP_BLK(TO, FROM) \ +do { \ + (TO)->time.secs = (FROM)->time.secs; \ + (TO)->time.usecs = (FROM)->time.usecs; \ + (TO)->type = (FROM)->type; \ + (TO)->pointer = (FROM)->pointer; \ + (TO)->size = (FROM)->size; \ +} while (0) + +int +emtbt_alloc_op(emtbt_table *tab, emtp_operation *op) +{ + int res; + emtbt_block *blk; + + blk = block_alloc(tab); + if (!blk) + return ENOMEM; + + blk->time.secs = op->time.secs; + blk->time.usecs = op->time.usecs; + blk->type = op->u.block.type; + blk->pointer = op->u.block.new_ptr; + blk->size = op->u.block.new_size; + + res = insert_block(tab, blk); + if (res < 0) + return ENOMEM; + else if (res == 0) + return EMTBT_ALLOC_XBLK_ERROR; + return 0; +} + +int +emtbt_realloc_op(emtbt_table *tab, emtp_operation *op, emtbt_block *old_blk) +{ + int res; + emtbt_block *blk; + + if (!op->u.block.new_size) { + /* freed block */ + + blk = fetch_block(tab, op->u.block.prev_ptr); + if (!blk) + return EMTBT_REALLOC_NOBLK_ERROR; + + CP_BLK(old_blk, blk); + block_free(tab, blk); + } + else { + + if (!op->u.block.new_ptr) { + /* failed operation */ + if (!op->u.block.prev_ptr) + CP_BLK(old_blk, &null_blk); + else { + blk = peek_block(tab, op->u.block.prev_ptr); + if (!blk) + return EMTBT_REALLOC_NOBLK_ERROR; + CP_BLK(old_blk, blk); +#if 0 + if (blk->type != op->u.block.type) + return EMTBT_REALLOC_BLK_TYPE_MISMATCH; +#endif + } + } + else if (!op->u.block.prev_ptr) { + /* new block */ + + CP_BLK(old_blk, &null_blk); + blk = block_alloc(tab); + if (!blk) + return ENOMEM; + blk->type = op->u.block.type; + blk->pointer = op->u.block.new_ptr; + blk->time.secs = op->time.secs; + blk->time.usecs = op->time.usecs; + blk->size = op->u.block.new_size; + + res = insert_block(tab, blk); + if (res < 0) + return ENOMEM; + else if (res == 0) + return EMTBT_REALLOC_XBLK_ERROR; + } + else if (op->u.block.new_ptr == op->u.block.prev_ptr) { + /* resized block */ + blk = peek_block(tab, op->u.block.prev_ptr); + if (!blk) + return EMTBT_REALLOC_NOBLK_ERROR; + CP_BLK(old_blk, blk); + blk->time.secs = op->time.secs; + blk->time.usecs = op->time.usecs; + blk->size = op->u.block.new_size; +#if 0 + if (blk->type != op->u.block.type) + return EMTBT_REALLOC_BLK_TYPE_MISMATCH; +#endif + } + else { + /* moved block */ + blk = fetch_block(tab, op->u.block.prev_ptr); + if (!blk) + return EMTBT_REALLOC_NOBLK_ERROR; + CP_BLK(old_blk, blk); + blk->time.secs = op->time.secs; + blk->time.usecs = op->time.usecs; + blk->pointer = op->u.block.new_ptr; + blk->size = op->u.block.new_size; + res = insert_block(tab, blk); + if (res < 0) + return ENOMEM; + else if (res == 0) + return EMTBT_REALLOC_XBLK_ERROR; +#if 0 + if (blk->type != op->u.block.type) + return EMTBT_REALLOC_BLK_TYPE_MISMATCH; +#endif + } + } + return 0; + +} + + +int +emtbt_free_op(emtbt_table *tab, emtp_operation *op, emtbt_block *old_blk) +{ + emtbt_block *blk; + + if (!op->u.block.prev_ptr) + CP_BLK(old_blk, &null_blk); + else { + + blk = fetch_block(tab, op->u.block.prev_ptr); + if (!blk) + return EMTBT_FREE_NOBLK_ERROR; + + CP_BLK(old_blk, blk); + block_free(tab, blk); +#if 0 + if (blk->type != op->u.block.type) + return EMTBT_FREE_BLK_TYPE_MISMATCH; +#endif + } + return 0; +} diff --git a/lib/tools/c_src/erl_memory_trace_block_table.h b/lib/tools/c_src/erl_memory_trace_block_table.h new file mode 100644 index 0000000000..1b1f23c16f --- /dev/null +++ b/lib/tools/c_src/erl_memory_trace_block_table.h @@ -0,0 +1,73 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance 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$ + */ + + +/* + * Description: + * + * Author: Rickard Green + */ + +#ifndef ERL_MEMORY_TRACE_BLOCK_TABLE_H__ +#define ERL_MEMORY_TRACE_BLOCK_TABLE_H__ + +#include +#include "erl_fixed_size_int_types.h" +#include "erl_memory_trace_parser.h" + + +#define EMTBT_ALLOC_XBLK_ERROR (EMTP_MIN_ERROR - 1) +#define EMTBT_REALLOC_NOBLK_ERROR (EMTP_MIN_ERROR - 2) +#define EMTBT_REALLOC_XBLK_ERROR (EMTP_MIN_ERROR - 3) +#define EMTBT_REALLOC_BLK_TYPE_MISMATCH (EMTP_MIN_ERROR - 4) +#define EMTBT_FREE_NOBLK_ERROR (EMTP_MIN_ERROR - 5) +#define EMTBT_FREE_BLK_TYPE_MISMATCH (EMTP_MIN_ERROR - 6) +#define EMTBT_INTERNAL_ERROR (EMTP_MIN_ERROR - 7) + +#define EMTBT_MIN_ERROR EMTBT_INTERNAL_ERROR + + +typedef struct emtbt_block_ { + + struct emtbt_block_ * next; + struct emtbt_block_ * prev; + usgnd_int_32 hash; + struct emtbt_block_ ** bucket; + + struct { + usgnd_int_32 secs; + usgnd_int_32 usecs; + } time; + usgnd_int_16 type; + usgnd_int_max pointer; + usgnd_int_max size; +} emtbt_block; + +typedef struct emtbt_table_ emtbt_table; + +const char *emtbt_error_string(int); +emtbt_table *emtbt_new_table(int, + void * (*)(size_t), + void * (*)(void *, size_t), + void (*)(void *)); +void emtbt_destroy_table(emtbt_table *); +int emtbt_alloc_op(emtbt_table *tab, emtp_operation *op); +int emtbt_realloc_op(emtbt_table *, emtp_operation *, emtbt_block *); +int emtbt_free_op(emtbt_table *, emtp_operation *, emtbt_block *); + +#endif diff --git a/lib/tools/doc/html/.gitignore b/lib/tools/doc/html/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/tools/doc/man3/.gitignore b/lib/tools/doc/man3/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/tools/doc/pdf/.gitignore b/lib/tools/doc/pdf/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/tools/doc/src/Makefile b/lib/tools/doc/src/Makefile new file mode 100644 index 0000000000..bab607c4bd --- /dev/null +++ b/lib/tools/doc/src/Makefile @@ -0,0 +1,132 @@ +# +# %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 +VSN=$(TOOLS_VSN) +APPLICATION=tools + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +XML_APPLICATION_FILES = ref_man.xml + +XML_REF3_FILES = \ + cover.xml \ + eprof.xml \ + fprof.xml \ + cprof.xml \ + instrument.xml \ + make.xml \ + tags.xml \ + xref.xml \ + erlang_mode.xml + +XML_PART_FILES = part.xml part_notes.xml part_notes_history.xml + +XML_CHAPTER_FILES = \ + cover_chapter.xml \ + fprof_chapter.xml \ + cprof_chapter.xml \ + erlang_mode_chapter.xml \ + xref_chapter.xml \ + notes.xml \ + notes_history.xml + + +BOOK_FILES = book.xml + +XML_FILES = \ + $(BOOK_FILES) $(XML_CHAPTER_FILES) \ + $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) + +GIF_FILES = \ + venn1.gif \ + venn2.gif + +# ---------------------------------------------------- + +HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ + $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) + +INFO_FILE = ../../info + +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 + +$(TOP_PDF_FILE): $(XML_FILES) + +pdf: $(TOP_PDF_FILE) + +html: gifs $(HTML_REF_MAN_FILE) + +man: $(MAN3_FILES) + +gifs: $(GIF_FILES:%=$(HTMLDIR)/%) + +debug opt: + +clean clean_docs: + rm -rf $(HTMLDIR)/* + 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 + +release_spec: + diff --git a/lib/tools/doc/src/book.xml b/lib/tools/doc/src/book.xml new file mode 100644 index 0000000000..96f6c426c3 --- /dev/null +++ b/lib/tools/doc/src/book.xml @@ -0,0 +1,47 @@ + + + + +

+ + 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. + + + + Tools + + + + +
+ + + Tools + + + + + + + + + + + + + + + diff --git a/lib/tools/doc/src/cover.xml b/lib/tools/doc/src/cover.xml new file mode 100644 index 0000000000..323bd0dda8 --- /dev/null +++ b/lib/tools/doc/src/cover.xml @@ -0,0 +1,458 @@ + + + + +
+ + 2001 + 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. + + + cover + + + + +
+ cover + A Coverage Analysis Tool for Erlang + +

The module cover provides a set of functions for coverage + analysis of Erlang programs, counting how many times each + executable line of code is executed when a program is run.

+ + An executable line contains an Erlang expression such as a matching + or a function call. A blank line or a line containing a comment, + function head or pattern in a case- or receive statement + is not executable.

+

Coverage analysis can be used to verify test cases, making sure all + relevant code is covered, and may also be helpful when looking for + bottlenecks in the code.

+

Before any analysis can take place, the involved modules must be + Cover compiled. This means that some extra information is + added to the module before it is compiled into a binary which then + is loaded. The source file of the module is not affected and no + .beam file is created.

+

Each time a function in a Cover compiled module is called, + information about the call is added to an internal database of Cover. + The coverage analysis is performed by examining the contents of + the Cover database. The output Answer is determined by two + parameters, Level and Analysis.

+ + +

Level = module

+

Answer = {Module,Value}, where Module is the module + name.

+ + +

Level = function

+

Answer = [{Function,Value}], one tuple for each function in + the module. A function is specified by its module name M, + function name F and arity A as a tuple + {M,F,A}.

+ + +

Level = clause

+

Answer = [{Clause,Value}], one tuple for each clause in + the module. A clause is specified by its module name M, + function name F, arity A and position in the function + definition C as a tuple {M,F,A,C}.

+ + +

Level = line

+

Answer = [{Line,Value}], one tuple for each executable + line in the module. A line is specified by its module name M + and line number in the source file N as a tuple + {M,N}.

+ + +

Analysis = coverage

+

Value = {Cov,NotCov} where Cov is the number of + executable lines in the module, function, clause or line that have + been executed at least once and NotCov is the number of + executable lines that have not been executed.

+ + +

Analysis = calls

+

Value = Calls which is the number of times the module, + function, or clause has been called. In the case of line level + analysis, Calls is the number of times the line has been + executed.

+ + +

Distribution

+

Cover can be used in a distributed Erlang system. One of the + nodes in the system must then be selected as the main node, and all Cover commands must be executed from this + node. The error reason not_main_node is returned if an + interface function is called on one of the remote nodes.

+

Use cover:start/1 and cover:stop/1 to add or + remove nodes. The same Cover compiled code will be loaded on each + node, and analysis will collect and sum up coverage data results + from all nodes.

+ + + + start() -> {ok,Pid} | {error,Reason} + Start Cover. + + Pid = pid() + Reason = {already_started,Pid} + + +

Starts the Cover server which owns the Cover internal database. + This function is called automatically by the other functions in + the module.

+ + + + start(Nodes) -> {ok,StartedNodes} | {error,not_main_node} + Start Cover on remote nodes. + + Nodes = StartedNodes = [atom()] + + +

Starts a Cover server on the each of given nodes, and loads + all cover compiled modules.

+ + + + compile(ModFile) -> Result + compile(ModFile, Options) -> Result + compile_module(ModFile) -> Result + compile_module(ModFile, Options) -> Result + Compile a module for Cover analysis. + + ModFile = Module | File +  Module = atom() +  File = string() + Options = [Option] +  Option = {i,Dir} | {d,Macro} | {d,Macro,Value} + See compile:file/2. + Result = {ok,Module} | {error,File} | {error,not_main_node} + + +

Compiles a module for Cover analysis. The module is given by its + module name Module or by its file name File. + The .erl extension may be omitted. If the module is + located in another directory, the path has to be specified.

+

Options is a list of compiler options which defaults to + []. Only options defining include file directories and + macros are passed to compile:file/2, everything else is + ignored.

+

If the module is successfully Cover compiled, the function + returns {ok,Module}. Otherwise the function returns + {error,File}. Errors and warnings are printed as they + occur.

+

Note that the internal database is (re-)initiated during + the compilation, meaning any previously collected coverage data + for the module will be lost.

+ + + + compile_directory() -> [Result] | {error,Reason} + compile_directory(Dir) -> [Result] | {error,Reason} + compile_directory(Dir, Options) -> [Result] | {error,Reason} + Compile all modules in a directory for Cover analysis. + + Dir = string() + Options = [Option] + See compile_module/1,2 + Result = {ok,Module} | {error,File} | {error,not_main_node} + See compile_module/1,2 + Reason = eacces | enoent + + +

Compiles all modules (.erl files) in a directory + Dir for Cover analysis the same way as + compile_module/1,2 and returns a list with the return + values.

+

Dir defaults to the current working directory.

+

The function returns {error,eacces} if the directory is not + readable or {error,enoent} if the directory does not exist.

+ + + + compile_beam(ModFile) -> Result + Compile a module for Cover analysis, using an existing beam. + + ModFile = Module | BeamFile +  Module = atom() +  BeamFile = string() + Result = {ok,Module} | {error,BeamFile} | {error,Reason} +  Reason = non_existing | {no_abstract_code,BeamFile} | {encrypted_abstract_code,BeamFile} | {already_cover_compiled,no_beam_found,Module} | not_main_node + + +

Does the same as compile/1,2, but uses an existing + .beam file as base, i.e. the module is not compiled + from source. Thus compile_beam/1 is faster than + compile/1,2.

+

Note that the existing .beam file must contain + abstract code, i.e. it must have been compiled with + the debug_info option. If not, the error reason + {no_abstract_code,BeamFile} is returned. + If the abstract code is encrypted, and no key is available + for decrypting it, the error reason + If only the module name (i.e. not the full name of the .beam]]> file) is given to this function, the + .beam file is found by calling + code:which(Module). If no .beam file is found, + the error reason non_existing is returned. If the + module is already cover compiled with compile_beam/1, + the .beam file will be picked from the same location + as the first time it was compiled. If the module is already + cover compiled with compile/1,2, there is no way to + find the correct .beam file, so the error reason + {already_cover_compiled,no_beam_found,Module} is + returned.

+

{error,BeamFile} is returned if the compiled code + can not be loaded on the node.

+ + + + compile_beam_directory() -> [Result] | {error,Reason} + compile_beam_directory(Dir) -> [Result] | {error,Reason} + Compile all .beam files in a directory for Cover analysis. + + Dir = string() + Result = See compile_beam/1 + Reason = eacces | enoent + + +

Compiles all modules (.beam files) in a directory + Dir for Cover analysis the same way as + compile_beam/1 and returns a list with the return + values.

+

Dir defaults to the current working directory.

+

The function returns {error,eacces} if the directory is not + readable or {error,enoent} if the directory does not exist.

+ + + + analyse(Module) -> {ok,Answer} | {error,Error} + analyse(Module, Analysis) -> {ok,Answer} | {error,Error} + analyse(Module, Level) -> {ok,Answer} | {error,Error} + analyse(Module, Analysis, Level) -> {ok,Answer} | {error,Error} + Analyse a Cover compiled module. + + Module = atom() + Analysis = coverage | calls + Level = line | clause | function | module + Answer = {Module,Value} | [{Item,Value}] +  Item = Line | Clause | Function +   Line = {M,N} +   Clause = {M,F,A,C} +   Function = {M,F,A} +    M = F = atom() +    N = A = C = integer() +  Value = {Cov,NotCov} | Calls +   Cov = NotCov = Calls = integer() + Error = {not_cover_compiled,Module} | not_main_node + + +

Performs analysis of a Cover compiled module Module, as + specified by Analysis and Level (see above), by + examining the contents of the internal database.

+

Analysis defaults to coverage and Level + defaults to function.

+

If Module is not Cover compiled, the function returns + {error,{not_cover_compiled,Module}}.

+ + + + analyse_to_file(Module) -> + analyse_to_file(Module,Options) -> + analyse_to_file(Module, OutFile) -> + analyse_to_file(Module, OutFile, Options) -> {ok,OutFile} | {error,Error} + Detailed coverage analysis of a Cover compiled module. + + Module = atom() + OutFile = string() + Options = [Option] + Option = html + Error = {not_cover_compiled,Module} | {file,File,Reason} | no_source_code_found | not_main_node +  File = string() +  Reason = term() + + +

Makes a copy OutFile of the source file for a module + Module, where it for each executable line is specified + how many times it has been executed.

+

The output file OutFile defaults to + Module.COVER.out, or Module.COVER.html if the + option html was used.

+

If Module is not Cover compiled, the function returns + {error,{not_cover_compiled,Module}}.

+

If the source file and/or the output file cannot be opened using + file:open/2, the function returns + {error,{file,File,Reason}} where File is the file + name and Reason is the error reason.

+

If the module was cover compiled from the .beam + file, i.e. using compile_beam/1 or + compile_beam_directory/0,1, it is assumed that the + source code can be found in the same directory as the + .beam file, or in ../src relative to that + directory. If no source code is found, + ,{error,no_source_code_found} is returned.

+ + + + modules() -> [Module] | {error,not_main_node} + Return all Cover compiled modules. + + Module = atom() + + +

Returns a list with all modules that are currently Cover + compiled.

+ + + + imported_modules() -> [Module] | {error,not_main_node} + Return all modules for which there are imported data. + + Module = atom() + + +

Returns a list with all modules for which there are + imported data.

+ + + + imported() -> [File] | {error,not_main_node} + Return all imported files. + + File = string() + + +

Returns a list with all imported files.

+ + + + which_nodes() -> [Node] | {error,not_main_node} + Return all nodes that are part of the coverage analysis. + + Node = atom() + + +

Returns a list with all nodes that are part of the coverage + analysis. Note that the current node is not returned. This + node is always part of the analysis.

+ + + + is_compiled(Module) -> {file,File} | false | {error,not_main_node} + Check if a module is Cover compiled. + + Module = atom() + Beam = string() + + +

Returns {file,File} if the module Module is + Cover compiled, or false otherwise. File is + the .erl file used by cover:compile_module/1,2 + or the .beam file used by compile_beam/1.

+ + + + reset(Module) -> + reset() -> ok | {error,not_main_node} + Reset coverage data for Cover compiled modules. + + Module = atom() + + +

Resets all coverage data for a Cover compiled module + Module in the Cover database on all nodes. If the + argument is omitted, the coverage data will be reset for all + modules known by Cover.

+

If Module is not Cover compiled, the function returns + {error,{not_cover_compiled,Module}}.

+ + + + export(ExportFile) + export(ExportFile,Module) -> ok | {error,Reason} + Reset coverage data for Cover compiled modules. + + ExportFile = string() + Module = atom() + Reason = {not_cover_compiled,Module} | {cant_open_file,ExportFile,Reason} | not_main_node + + +

Exports the current coverage data for Module to the + file ExportFile. It is recommended to name the + ExportFile with the extension .coverdata, since + other filenames can not be read by the web based interface to + cover.

+

If Module is not given, data for all Cover compiled + or earlier imported modules is exported.

+

This function is useful if coverage data from different + systems is to be merged.

+

See also cover:import/1

+ + + + import(ExportFile) -> ok | {error,Reason} + Reset coverage data for Cover compiled modules. + + ExportFile = string() + Reason = {cant_open_file,ExportFile,Reason} | not_main_node + + +

Imports coverage data from the file ExportFile + created with cover:export/1,2. Any analysis performed + after this will include the imported data.

+

Note that when compiling a module all existing coverage data is removed, including imported data. If a module is + already compiled when data is imported, the imported data is + added to the existing coverage data.

+

Coverage data from several export files can be imported + into one system. The coverage data is then added up when + analysing.

+

Coverage data for a module can not be imported from the + same file twice unless the module is first reset or + compiled. The check is based on the filename, so you can + easily fool the system by renaming your export file.

+

See also cover:export/1,2

+ + + + stop() -> ok | {error,not_main_node} + Stop Cover. + +

Stops the Cover server and unloads all Cover compiled code.

+ + + + stop(Nodes) -> ok | {error,not_main_node} + Stop Cover on remote nodes. + + Nodes = [atom()] + + +

Stops the Cover server and unloads all Cover compiled code + on the given nodes. Data stored in the Cover database on the + remote nodes is fetched and stored on the main node.

+ + + + +
+ SEE ALSO +

code(3), compile(3)

+
+ + diff --git a/lib/tools/doc/src/cover_chapter.xml b/lib/tools/doc/src/cover_chapter.xml new file mode 100644 index 0000000000..b4f7919183 --- /dev/null +++ b/lib/tools/doc/src/cover_chapter.xml @@ -0,0 +1,490 @@ + + + + +
+ + 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. + + + + cover + + + + + cover_chapter.xml +
+ +
+ Introduction +

The module cover provides a set of functions for coverage + analysis of Erlang programs, counting how many times each + executable line is executed.

+

Coverage analysis can be used to verify test cases, making sure all + relevant code is covered, and may be helpful when looking for + bottlenecks in the code.

+
+ +
+ Getting Started With Cover + +
+ Example +

Assume that a test case for the following program should be + verified:

+ +-module(channel). +-behaviour(gen_server). + +-export([start_link/0,stop/0]). +-export([alloc/0,free/1]). % client interface +-export([init/1,handle_call/3,terminate/2]). % callback functions + +start_link() -> + gen_server:start_link({local,channel},channel,[],[]). + +stop() -> + gen_server:call(channel,stop). + +%%%-Client interface functions------------------------------------------- + +alloc() -> + gen_server:call(channel,alloc). + +free(Channel) -> + gen_server:call(channel,{free,Channel}). + +%%%-gen_server callback functions---------------------------------------- + +init(_Arg) -> + {ok,channels()}. + +handle_call(stop,Client,Channels) -> + {stop,normal,ok,Channels}; + +handle_call(alloc,Client,Channels) -> + {Ch,Channels2} = alloc(Channels), + {reply,{ok,Ch},Channels2}; + +handle_call({free,Channel},Client,Channels) -> + Channels2 = free(Channel,Channels), + {reply,ok,Channels2}. + +terminate(_Reason,Channels) -> + ok. + +%%%-Internal functions--------------------------------------------------- + +channels() -> + [ch1,ch2,ch3]. + +alloc([Channel|Channels]) -> + {Channel,Channels}; +alloc([]) -> + false. + +free(Channel,Channels) -> + [Channel|Channels]. +

The test case is implemented as follows:

+ +-module(test). +-export([s/0]). + +s() -> + {ok,Pid} = channel:start_link(), + {ok,Ch1} = channel:alloc(), + ok = channel:free(Ch1), + ok = channel:stop(). +
+ +
+ Preparation +

First of all, Cover must be started. This spawns a process which + owns the Cover database where all coverage data will be stored.

+ 
+1> cover:start().
+{ok,<0.30.0>}
+

To include other nodes in the coverage analysis, use + start/1. All cover compiled modules will then be loaded + on all nodes, and data from all nodes will be summed up when + analysing. For simplicity this example only involves the + current node.

+

Before any analysis can take place, the involved modules must be + Cover compiled. This means that some extra information is + added to the module before it is compiled into a binary which then + is loaded. The source file of + the module is not affected and no .beam file is created.

+ 
+2> cover:compile_module(channel).
+{ok,channel}
+

Each time a function in the Cover compiled module channel + is called, information about the call will be added to the Cover + database. Run the test case:

+ 
+3> test:s().
+ok
+

Cover analysis is performed by examining the contents of the Cover + database. The output is determined by two parameters, Level + and Analysis. Analysis is either coverage or + calls and determines the type of the analysis. Level + is either module, function, clause, or + line and determines the level of the analysis.

+
+ +
+ Coverage Analysis +

Analysis of type coverage is used to find out how much of + the code has been executed and how much has not been executed. + Coverage is represented by a tuple {Cov,NotCov}, where + Cov is the number of executable lines that have been executed + at least once and NotCov is the number of executable lines + that have not been executed.

+

If the analysis is made on module level, the result is given for + the entire module as a tuple {Module,{Cov,NotCov}}:

+ 
+4> cover:analyse(channel,coverage,module).
+{ok,{channel,{14,1}}}
+

For channel, the result shows that 14 lines in the module + are covered but one line is not covered.

+

If the analysis is made on function level, the result is given as + a list of tuples {Function,{Cov,NotCov}}, one for each + function in the module. A function is specified by its module name, + function name and arity:

+ 
+5> cover:analyse(channel,coverage,function).
+{ok,[{{channel,start_link,0},{1,0}},
+     {{channel,stop,0},{1,0}},
+     {{channel,alloc,0},{1,0}},
+     {{channel,free,1},{1,0}},
+     {{channel,init,1},{1,0}},
+     {{channel,handle_call,3},{5,0}},
+     {{channel,terminate,2},{1,0}},
+     {{channel,channels,0},{1,0}},
+     {{channel,alloc,1},{1,1}},
+     {{channel,free,2},{1,0}}]}
+

For channel, the result shows that the uncovered line is in + the function channel:alloc/1.

+

If the analysis is made on clause level, the result is given as + a list of tuples {Clause,{Cov,NotCov}}, one for each + function clause in the module. A clause is specified by its module + name, function name, arity and position within the function + definition:

+ 
+6> cover:analyse(channel,coverage,clause).
+{ok,[{{channel,start_link,0,1},{1,0}},
+     {{channel,stop,0,1},{1,0}},
+     {{channel,alloc,0,1},{1,0}},
+     {{channel,free,1,1},{1,0}},
+     {{channel,init,1,1},{1,0}},
+     {{channel,handle_call,3,1},{1,0}},
+     {{channel,handle_call,3,2},{2,0}},
+     {{channel,handle_call,3,3},{2,0}},
+     {{channel,terminate,2,1},{1,0}},
+     {{channel,channels,0,1},{1,0}},
+     {{channel,alloc,1,1},{1,0}},
+     {{channel,alloc,1,2},{0,1}},
+     {{channel,free,2,1},{1,0}}]}
+

For channel, the result shows that the uncovered line is in + the second clause of channel:alloc/1.

+

Finally, if the analysis is made on line level, the result is given + as a list of tuples {Line,{Cov,NotCov}}, one for each + executable line in the source code. A line is specified by its + module name and line number.

+ 
+7> cover:analyse(channel,coverage,line).
+{ok,[{{channel,9},{1,0}},
+     {{channel,12},{1,0}},
+     {{channel,17},{1,0}},
+     {{channel,20},{1,0}},
+     {{channel,25},{1,0}},
+     {{channel,28},{1,0}},
+     {{channel,31},{1,0}},
+     {{channel,32},{1,0}},
+     {{channel,35},{1,0}},
+     {{channel,36},{1,0}},
+     {{channel,39},{1,0}},
+     {{channel,44},{1,0}},
+     {{channel,47},{1,0}},
+     {{channel,49},{0,1}},
+     {{channel,52},{1,0}}]}
+

For channel, the result shows that the uncovered line is + line number 49.

+
+ +
+ Call Statistics +

Analysis of type calls is used to find out how many times + something has been called and is represented by an integer + Calls.

+

If the analysis is made on module level, the result is given as a + tuple {Module,Calls}. Here Calls is the total number + of calls to functions in the module:

+ 
+8> cover:analyse(channel,calls,module).
+{ok,{channel,12}}
+

For channel, the result shows that a total of twelve calls + have been made to functions in the module.

+

If the analysis is made on function level, the result is given as + a list of tuples {Function,Calls}. Here Calls is + the number of calls to each function:

+ 
+9> cover:analyse(channel,calls,function).
+{ok,[{{channel,start_link,0},1},
+     {{channel,stop,0},1},
+     {{channel,alloc,0},1},
+     {{channel,free,1},1},
+     {{channel,init,1},1},
+     {{channel,handle_call,3},3},
+     {{channel,terminate,2},1},
+     {{channel,channels,0},1},
+     {{channel,alloc,1},1},
+     {{channel,free,2},1}]}
+

For channel, the result shows that handle_call/3 is + the most called function in the module (three calls). All other + functions have been called once.

+

If the analysis is made on clause level, the result is given as + a list of tuples {Clause,Calls}. Here Calls is + the number of calls to each function clause:

+ 
+10> cover:analyse(channel,calls,clause).
+{ok,[{{channel,start_link,0,1},1},
+     {{channel,stop,0,1},1},
+     {{channel,alloc,0,1},1},
+     {{channel,free,1,1},1},
+     {{channel,init,1,1},1},
+     {{channel,handle_call,3,1},1},
+     {{channel,handle_call,3,2},1},
+     {{channel,handle_call,3,3},1},
+     {{channel,terminate,2,1},1},
+     {{channel,channels,0,1},1},
+     {{channel,alloc,1,1},1},
+     {{channel,alloc,1,2},0},
+     {{channel,free,2,1},1}]}
+

For channel, the result shows that all clauses have been + called once, except the second clause of channel:alloc/1 + which has not been called at all.

+

Finally, if the analysis is made on line level, the result is given + as a list of tuples {Line,Calls}. Here Calls is + the number of times each line has been executed:

+ 
+11> cover:analyse(channel,calls,line).
+{ok,[{{channel,9},1},
+     {{channel,12},1},
+     {{channel,17},1},
+     {{channel,20},1},
+     {{channel,25},1},
+     {{channel,28},1},
+     {{channel,31},1},
+     {{channel,32},1},
+     {{channel,35},1},
+     {{channel,36},1},
+     {{channel,39},1},
+     {{channel,44},1},
+     {{channel,47},1},
+     {{channel,49},0},
+     {{channel,52},1}]}
+

For channel, the result shows that all lines have been + executed once, except line number 49 which has not been executed at + all.

+
+ +
+ Analysis to File +

A line level calls analysis of channel can be written to + a file using cover:analysis_to_file/1:

+ 
+12> cover:analyse_to_file(channel).
+{ok,"channel.COVER.out"}
+

The function creates a copy of channel.erl where it for + each executable line is specified how many times that line has been + executed. The output file is called channel.COVER.out.

+ 
+File generated from channel.erl by COVER 2001-05-21 at 11:16:38
+
+****************************************************************************
+
+        |  -module(channel).
+        |  -behaviour(gen_server).
+        |  
+        |  -export([start_link/0,stop/0]).
+        |  -export([alloc/0,free/1]). % client interface
+        |  -export([init/1,handle_call/3,terminate/2]). % callback functions
+        |  
+        |  start_link() ->
+     1..|      gen_server:start_link({local,channel},channel,[],[]).
+        |  
+        |  stop() ->
+     1..|      gen_server:call(channel,stop).
+        |  
+        |  %%%-Client interface functions------------------------------------
+        |  
+        |  alloc() ->
+     1..|      gen_server:call(channel,alloc).
+        |  
+        |  free(Channel) ->
+     1..|      gen_server:call(channel,{free,Channel}).
+        |  
+        |  %%%-gen_server callback functions---------------------------------
+        |  
+        |  init(_Arg) ->
+     1..|      {ok,channels()}.
+        |  
+        |  handle_call(stop,Client,Channels) ->
+     1..|      {stop,normal,ok,Channels};
+        |  
+        |  handle_call(alloc,Client,Channels) ->
+     1..|      {Ch,Channels2} = alloc(Channels),
+     1..|      {reply,{ok,Ch},Channels2};
+        |  
+        |  handle_call({free,Channel},Client,Channels) ->
+     1..|      Channels2 = free(Channel,Channels),
+     1..|      {reply,ok,Channels2}.
+        |  
+        |  terminate(_Reason,Channels) ->
+     1..|      ok.
+        |  
+        |  %%%-Internal functions--------------------------------------------
+        |  
+        |  channels() ->
+     1..|      [ch1,ch2,ch3].
+        |  
+        |  alloc([Channel|Channels]) ->
+     1..|      {Channel,Channels};
+        |  alloc([]) ->
+     0..|      false.
+        |  
+        |  free(Channel,Channels) ->
+     1..|      [Channel|Channels].
+
+ +
+ Conclusion +

By looking at the results from the analyses, it can be deducted + that the test case does not cover the case when all channels are + allocated and test.erl should be extended accordingly.

+ + Incidentally, when the test case is corrected a bug in channel + should indeed be discovered.

+

When the Cover analysis is ready, Cover is stopped and all Cover + compiled modules are unloaded. + The code for channel is now loaded as usual from a + .beam file in the current path.

+ 
+13> code:which(channel).
+cover_compiled
+14> cover:stop().
+ok
+15> code:which(channel).
+"./channel.beam"
+
+
+ +
+ Miscellaneous + +
+ Performance +

Execution of code in Cover compiled modules is slower and more + memory consuming than for regularly compiled modules. As the Cover + database contains information about each executable line in each + Cover compiled module, performance decreases proportionally to + the size and number of the Cover compiled modules.

+
+ +
+ + Executable Lines +

Cover uses the concept of executable lines, which is lines + of code containing an executable expression such as a matching or + a function call. A blank line or a line containing a comment, + function head or pattern in a case- or receive + statement is not executable.

+

In the example below, lines number 2,4,6,8 and 11 are executable + lines:

+

+ 
+1: is_loaded(Module,Compiled) ->
+2:   case get_file(Module,Compiled) of
+3:     {ok,File} ->
+4:       case code:which(Module) of
+5:         ?TAG ->
+6:           {loaded,File};
+7:         _ ->
+8:           unloaded
+9:       end;
+10:    false ->
+11:      false
+12:  end.
+
+ +
+ + Code Loading Mechanism +

When a module is Cover compiled, it is also loaded using the normal + code loading mechanism of Erlang. This means that if a Cover + compiled module is re-loaded during a Cover session, for example + using c(Module), it will no longer be Cover compiled.

+

Use cover:is_compiled/1 or code:which/1 to see if + a module is Cover compiled (and still loaded) or not.

+

When Cover is stopped, all Cover compiled modules are unloaded.

+
+
+ +
+ Using the Web Based User Interface to Cover + +
+ Introduction +

To ease the use of Cover there is a web based user interface + to Cover called WebCover. WebCover is designed to be started + and used via WebTool. It is possible to Cover compile Erlang + modules and to generate printable Cover and Call analyses via + the web based user interface.

+
+ +
+ Start the Web Based User Interface to Cover +

To start WebCover you can either start WebTool, point a + browser to the start page of WebTool and start WebCover from + there, or you can use the start_webtool script to start + Webtool, WebCover and a browser. See WebTool documentation for + further information.

+

Currently WebCover is only compatible + with Internet Explorer and Netscape Navigator 4.0 and higher.

+
+ +
+ Navigating WebCover +

From the menu in the lefthand frame you can select the + Nodes, Compile, Import or Result + page.

+

From the Nodes page you can add remote nodes to + participate in the coverage analysis. Coverage data from all + involved nodes will then be merged during analysis.

+

From the Compile page you can Cover compile .erl + or .beam files.

+

From the Import page you can import coverage data from + a previous analysis. Imported data will then be merged with + the current coverage data. Note that it is only possible to + import files with the extension .coverdata.

+

From the Result page you can analyse, reset or export + coverage data.

+

Please follow the instructions on each page.

+
+
+ + diff --git a/lib/tools/doc/src/cprof.xml b/lib/tools/doc/src/cprof.xml new file mode 100644 index 0000000000..421ed7875a --- /dev/null +++ b/lib/tools/doc/src/cprof.xml @@ -0,0 +1,294 @@ + + + + +
+ + 2002 + 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. + + + cprof + Raimo Niskanen + nobody + + nobody + + 2002-09-12 + PA1 + cprof.sgml +
+ cprof + A simple Call Count Profiling Tool using breakpoints for minimal runtime performance impact. + +

The cprof module is used to profile a program + to find out how many times different functions are called. + Breakpoints similar to local call trace, but containing a + counter, are used to minimise runtime performance impact. +

+

Since breakpoints are used there is no need for special + compilation of any module to be profiled. For now these + breakpoints can only be set on BEAM code so s + cannot be call count traced. +

+

The size of the call counters is the host machine word + size. One bit is used when pausing the counter, so the maximum + counter value for a 32-bit host is 2147483647. +

+

The profiling result is delivered as a term containing a + sorted list of entries, one per module. Each module entry + contains a sorted list of functions. The sorting order in both + cases is of decreasing call count. +

+

Call count tracing is very lightweight compared to other forms + of tracing since no trace message has to be generated. Some + measurements indicates performance degradation in the vicinity + of 10 percent. + +

+ + + + analyse() -> {AllCallCount, ModAnalysisList} + analyse(Limit) -> {AllCallCount, ModAnalysisList} + analyse(Mod) -> ModAnlysis + analyse(Mod, Limit) -> ModAnalysis + Collect and analyse call counters. + + Limit = integer() + Mod = atom() + AllCallCount = integer() + ModAnalysisList = [ModAnalysis] + ModAnalysis = {Mod, ModCallCount, FuncAnalysisList} + ModCallCount = integer() + FuncAnalysisList = [{{Mod, Func, Arity}, FuncCallCount}] + Func = atom() + Arity = integer() + FuncCallCount = integer() + + +

Collects and analyses the call counters presently in the + node for either module Mod, or for all modules + (except cprof itself), and returns:

+ + FuncAnalysisList + A list of tuples, one for each function in a module, in + decreasing FuncCallCount order. + ModCallCount + The sum of FuncCallCount values for all + functions in module Mod. + AllCallCount + The sum of ModCallCount values for all modules + concerned in ModAnalysisList. + ModAnalysisList + A list of tuples, one for each module except + cprof, in decreasing ModCallCount order. + +

If call counters are still running while + analyse/0..2 is executing, you might get an + inconsistent result. This happens if the process executing + analyse/0..2 gets scheduled out so some other process + can increment the counters that are being analysed, Calling + pause() before analysing takes care of the problem. +

+

If the Mod argument is given, the result contains a + ModAnalysis tuple for module Mod only, + otherwise the result contains one ModAnalysis tuple + for all modules returned from code:all_loaded() + except cprof itself. +

+

All functions with a FuncCallCount lower than + Limit are excluded from FuncAnalysisList. They + are still included in ModCallCount, though. + The default value for Limit is 1. + +

+ + + + pause() -> integer() + Pause running call count trace for all functions. + +

Pause call count tracing for all functions in all modules + and stop it for all functions in modules to be + loaded. This is the same as + (pause({'_','_','_'})+stop({on_load})). +

+

See also + pause/1..3 below. + +

+ + + + pause(FuncSpec) -> integer() + pause(Mod, Func) -> integer() + pause(Mod, Func, Arity) -> integer() + Pause running call count trace for matching functions. + + FuncSpec = Mod | {Mod,Func,Arity}, {FS} + Mod = atom() + Func = atom() + Arity = integer() + FS = term() + + +

Pause call counters for matching functions in matching + modules. The FS argument can be used to + specify the first argument to + erlang:trace_pattern/3. See erlang(3). +

+

The call counters for all matching functions that + has got call count breakpoints are paused at their current + count. +

+

Return the number of matching functions that can have + call count breakpoints, the same as + start/0..3 with the same arguments would have + returned. + +

+ + + + restart() -> integer() + restart(FuncSpec) -> integer() + restart(Mod, Func) -> integer() + restart(Mod, Func, Arity) -> integer() + Restart existing call counters for matching functions. + + FuncSpec = Mod | {Mod,Func,Arity}, {FS} + Mod = atom() + Func = atom() + Arity = integer() + FS = term() + + +

Restart call counters for the matching functions in + matching modules that are call count traced. The FS + argument can be used to specify the first argument to + erlang:trace_pattern/3. See erlang(3). +

+

The call counters for all matching functions that has got + call count breakpoints are set to zero and running. +

+

Return the number of matching functions that can have + call count breakpoints, the same as + start/0..3 with the same arguments would have + returned. + +

+ + + + start() -> integer() + Start call count tracing for all functions. + +

Start call count tracing for all functions in all modules, + and also for all functions in modules to be + loaded. This is the same as + (start({'_','_','_'})+start({on_load})). +

+

See also + start/1..3 below. + +

+ + + + start(FuncSpec) -> integer() + start(Mod, Func) -> integer() + start(Mod, Func, Arity) -> integer() + Start call count tracing for matching functions. + + FuncSpec = Mod | {Mod,Func,Arity}, {FS} + Mod = atom() + Func = atom() + Arity = integer() + FS = term() + + +

Start call count tracing for matching functions in matching + modules. The FS argument can be used to specify the + first argument to erlang:trace_pattern/3, for example + on_load. See erlang(3). +

+

Set call count breakpoints on the matching functions that + has no call count breakpoints. Call counters + are set to zero and running for all matching functions. +

+

Return the number of matching functions that has got + call count breakpoints. + +

+ + + + stop() -> integer() + Stop call count tracing for all functions. + +

Stop call count tracing for all functions in all modules, + and also for all functions in modules to be + loaded. This is the same as + (stop({'_','_','_'})+stop({on_load})). +

+

See also + stop/1..3 below. + +

+ + + + stop(FuncSpec) -> integer() + stop(Mod, Func) -> integer() + stop(Mod, Func, Arity) -> integer() + Stop call count tracing for matching functions. + + FuncSpec = Mod | {Mod,Func,Arity}, {FS} + Mod = atom() + Func = atom() + Arity = integer() + FS = term() + + +

Stop call count tracing for matching functions in matching + modules. The FS argument can be used to specify the + first argument to erlang:trace_pattern/3, for example + on_load. See erlang(3). +

+

Remove call count breakpoints from the matching functions that + has call count breakpoints. +

+

Return the number of matching functions that can have + call count breakpoints, the same as + start/0..3 with the same arguments would have + returned. +

+ + + + +
+ See Also +

eprof(3), + fprof(3), + erlang(3), + User's Guide

+
+ + diff --git a/lib/tools/doc/src/cprof_chapter.xml b/lib/tools/doc/src/cprof_chapter.xml new file mode 100644 index 0000000000..cf6a6f843a --- /dev/null +++ b/lib/tools/doc/src/cprof_chapter.xml @@ -0,0 +1,228 @@ + + + + +
+ + 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. + + + + cprof - The Call Count Profiler + Raimo Niskanen + nobody + + nobody + no + 2002-09-11 + PA1 + cprof_chapter.xml +
+

cprof is a profiling tool that can be used to get a picture of + how often different functions in the system are called. +

+

cprof uses breakpoints similar to local call trace, + but containing counters, to collect profiling + data. Therfore there is no need for special compilation of any + module to be profiled. +

+

cprof presents all profiled modules in decreasing total + call count order, and for each module presents all profiled + functions also in decreasing call count order. A call count limit + can be specified to filter out all functions below the limit. +

+

Profiling is done in the following steps:

+ + cprof:start/0..3 + Starts profiling with zeroed call counters for specified + functions by setting call count breakpoints on them. + Mod:Fun() + Runs the code to be profiled. + cprof:pause/0..3 + Pauses the call counters for specified functions. This minimises + the impact of code running in the background or in the shell + that disturbs the profiling. Call counters are automatically + paused when they "hit the ceiling" of the host machine word + size. For a 32 bit host the maximum counter value is + 2147483647. + cprof:analyse/0..2 + Collects call counters and computes the result. + cprof:restart/0..3 + Restarts the call counters from zero for specified + functions. Can be used to collect a new set of counters without + having to stop and start call count profiling. + cprof:stop/0..3 + Stops profiling by removing call count breakpoints from + specified functions. + +

Functions can be specified as either all in the system, all in one + module, all arities of one function, one function, or all + functions in all modules not yet loaded. As for now, BIFs cannot + be call count traced. +

+

The analysis result can either be for all modules, or for one + module. In either case a call count limit can be given to filter + out the functions with a call count below the limit. The all + modules analysis does not contain the module cprof + itself, it can only be analysed by specifying it as a single + module to analyse. +

+

Call count tracing is very lightweight compared to other forms of + tracing since no trace message has to be generated. Some + measurements indicates performance degradations in the vicinity of + 10 percent. +

+

The following sections show some examples of profiling with + cprof. See also + cprof(3). +

+ +
+ Example: Background work +

From the Erlang shell:

+ 
+1> cprof:start(), cprof:pause(). % Stop counters just after start
+3476
+2> cprof:analyse().
+{30,
+ [{erl_eval,11,
+            [{{erl_eval,expr,3},3},
+             {{erl_eval,'-merge_bindings/2-fun-0-',2},2},
+             {{erl_eval,expand_module_name,2},1},
+             {{erl_eval,merge_bindings,2},1},
+             {{erl_eval,binding,2},1},
+             {{erl_eval,expr_list,5},1},
+             {{erl_eval,expr_list,3},1},
+             {{erl_eval,exprs,4},1}]},
+  {orddict,8,
+           [{{orddict,find,2},6},
+            {{orddict,dict_to_list,1},1},
+            {{orddict,to_list,1},1}]},
+  {packages,7,[{{packages,is_segmented_1,1},6},
+               {{packages,is_segmented,1},1}]},
+  {lists,4,[{{lists,foldl,3},3},{{lists,reverse,1},1}]}]}
+3> cprof:analyse(cprof).
+{cprof,3,[{{cprof,tr,2},2},{{cprof,pause,0},1}]}
+4> cprof:stop().
+3476
+

The example showed the background work that the shell performs + just to interpret the first command line. Most work is done by + erl_eval and orddict. +

+

What is captured in this example is the part of the work the + shell does while interpreting the command line that occurs + between the actual calls to cprof:start() and + cprof:analyse(). +

+
+ +
+ Example: One module +

From the Erlang shell:

+ 
+1> cprof:start(),R=calendar:day_of_the_week(1896,4,27),cprof:pause(),R.
+1
+2> cprof:analyse(calendar).
+{calendar,9,
+          [{{calendar,df,2},1},
+           {{calendar,dm,1},1},
+           {{calendar,dy,1},1},
+           {{calendar,last_day_of_the_month1,2},1},
+           {{calendar,last_day_of_the_month,2},1},
+           {{calendar,is_leap_year1,1},1},
+           {{calendar,is_leap_year,1},1},
+           {{calendar,day_of_the_week,3},1},
+           {{calendar,date_to_gregorian_days,3},1}]}
+3> cprof:stop().
+3271
+

The example tells us that "Aktiebolaget LM Ericsson & Co" + was registered on a Monday (since the return value + of the first command is 1), and that the calendar module + needed 9 function calls to calculate that. +

+

Using cprof:analyse() in this example also shows + approximately the same background work as in the first example. +

+
+ +
+ Example: In the code +

Write a module:

+ 
+-module(sort).
+      
+-export([do/1]).
+      
+do(N) ->
+    cprof:stop(),
+    cprof:start(),
+    do(N, []).
+      
+do(0, L) ->
+    R = lists:sort(L),
+    cprof:pause(),
+    R;
+do(N, L) ->
+    do(N-1, [random:uniform(256)-1 | L]).
+

From the Erlang shell:

+ 
+1> c(sort).
+{ok,sort}
+2> l(random).
+{module,random}
+3> sort:do(1000).
+[0,0,1,1,1,1,1,1,2,2,2,3,3,3,3,3,4,4,4,5,5,5,5,6,6,6,6,6,6|...]
+4> cprof:analyse().
+{9050,
+ [{lists_sort,6047,
+              [{{lists_sort,merge3_2,6},923},
+               {{lists_sort,merge3_1,6},879},
+               {{lists_sort,split_2,5},661},
+               {{lists_sort,rmerge3_1,6},580},
+               {{lists_sort,rmerge3_2,6},543},
+               {{lists_sort,merge3_12_3,6},531},
+               {{lists_sort,merge3_21_3,6},383},
+               {{lists_sort,split_2_1,6},338},
+               {{lists_sort,rmerge3_21_3,6},299},
+               {{lists_sort,rmerge3_12_3,6},205},
+               {{lists_sort,rmerge2_2,4},180},
+               {{lists_sort,rmerge2_1,4},171},
+               {{lists_sort,merge2_1,4},127},
+               {{lists_sort,merge2_2,4},121},
+               {{lists_sort,mergel,2},79},
+               {{lists_sort,rmergel,2},27}]},
+  {random,2001,
+          [{{random,uniform,1},1000},
+           {{random,uniform,0},1000},
+           {{random,seed0,0},1}]},
+  {sort,1001,[{{sort,do,2},1001}]},
+  {lists,1,[{{lists,sort,1},1}]}]}
+5> cprof:stop().
+5369
+

The example shows some details of how lists:sort/1 + works. It used 6047 function calls in the module + lists_sort to complete the work. +

+

This time, since the shell was not involved, no other work was + done in the system during the profiling. If you retry the same + example with a freshly started Erlang emulator, but omit the + command l(random), the analysis will show a lot more + function calls done by code_server and others to + automatically load the module random. +

+
+ + diff --git a/lib/tools/doc/src/eprof.xml b/lib/tools/doc/src/eprof.xml new file mode 100644 index 0000000000..ae1033f2d0 --- /dev/null +++ b/lib/tools/doc/src/eprof.xml @@ -0,0 +1,150 @@ + + + + +
+ + 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. + + + + eprof + + + + +
+ eprof + A Time Profiling Tool for Erlang + +

The module eprof provides a set of functions for time + profiling of Erlang programs to find out how the execution time is + used. The profiling is done using the Erlang trace BIFs. Tracing of + local function calls for a specified set of processes is enabled when + profiling is begun, and disabled when profiling is stopped.

+

When using Eprof, expect a significant slowdown in program execution, + in most cases at least 100 percent.

+ + + + start() -> {ok,Pid} | {error,Reason} + Start Eprof. + + Pid = pid() + Reason = {already_started,Pid} + + +

Starts the Eprof server which owns the Eprof internal database.

+ + + + start_profiling(Rootset) -> profiling | error + profile(Rootset) -> profiling | error + Start profiling. + + Rootset = [atom() | pid()] + + +

Starts profiling for the processes in Rootset (and any new + processes spawned from them). Information about activity in any + profiled process is stored in the Eprof database.

+

Rootset is a list of pids and registered names.

+

The function returns profiling if tracing could be enabled + for all processes in Rootset, or error otherwise.

+ + + + stop_profiling() -> profiling_stopped | profiling_already_stopped + Stop profiling. + +

Stops profiling started with start_profiling/1 or + profile/1.

+ + + + profile(Rootset,Fun) -> {ok,Value} | {error,Reason} | error + profile(Rootset,Module,Function,Args) -> {ok,Value} | {error,Reason} | error + Start profiling. + + Rootset = [atom() | pid()] + Fun = fun() -> term() + Module = Function = atom() + Args = [term()] + Value = Reason = term() + + +

This function first spawns a process P which evaluates + Fun() or apply(Module,Function,Args). Then, it + starts profiling for P and the processes in Rootset + (and any new processes spawned from them). Information about + activity in any profiled process is stored in the Eprof database.

+

Rootset is a list of pids and registered names.

+

If tracing could be enabled for P and all processes in + Rootset, the function returns {ok,Value} when + Fun()/apply returns with the value Value, or + {error,Reason} if Fun()/apply fails with + exit reason Reason. Otherwise it returns error + immediately.

+

The programmer must ensure that the function given as argument + is truly synchronous and that no work continues after + the function has returned a value.

+ + + + analyse() + Display profiling results per process. + +

Call this function when profiling has been stopped to display + the results per process, that is:

+ + how much time has been used by each process, and + in which function calls this time has been spent. + +

Time is shown as percentage of total time, not as absolute time.

+ + + + total_analyse() + Display profiling results per function call. + +

Call this function when profiling has been stopped to display + the results per function call, that is in which function calls + the time has been spent.

+

Time is shown as percentage of total time, not as absolute time.

+ + + + log(File) -> ok + Activate logging of eprofprintouts. + + File = atom() | string() + + +

This function ensures that the results displayed by + analyse/0 and total_analyse/0 are printed both to + the file File and the screen.

+ + + + stop() -> stopped + Stop Eprof. + +

Stops the Eprof server.

+ + + + + diff --git a/lib/tools/doc/src/erlang_mode.xml b/lib/tools/doc/src/erlang_mode.xml new file mode 100644 index 0000000000..72770898c2 --- /dev/null +++ b/lib/tools/doc/src/erlang_mode.xml @@ -0,0 +1,324 @@ + + + + +
+ + 20032009 + 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 mode for Emacs + Ingela Anderton + + + + +
+ erlang.el + Erlang mode for Emacs + +

Possibly the most important feature of an editor designed for + programmers is the ability to indent a line of code in accordance + with the structure of the programming language. The Erlang mode + does, of course, provide this feature. The layout used is based + on the common use of the language. The mode also provides things as + syntax highlighting, electric commands, module name verification, + comment support including paragraph filling, skeletons, tags + support etc.

+

In the following descriptions the use of the word Point means: "Point can be seen as the position of the + cursor. More precisely, the point is the position between two + characters while the cursor is drawn over the character + following the point".

+ + +
+ Indent +

The following command are directly available for indentation.

+ + TAB (erlang-indent-command) - + Indents the current line of code. + M-C-\\ (indent-region) - Indents all + lines in the region. + M-l (indent-for-comment) - Insert a + comment character to the right of the code on the line (if + any). + +

Lines containing comment are indented differently depending on + the number of %-characters used:

+ + Lines with one %-character is indented to the right of + the code. The column is specified by the variable + comment-column, by default column 48 is used. + Lines with two %-characters will be indented to the same + depth as code would have been in the same situation. + Lines with three of more %-characters are indented to the + left margin. + C-c C-q (erlang-indent-function) - + Indents the current Erlang function. + M-x erlang-indent-clause RET

+ -Indent the + current Erlang clause. + M-x erlang-indent-current-buffer RET - + Indent the entire buffer. + +
+ +
+ Edit - Fill Comment +

When editing normal text in text mode you can let Emacs reformat the + text by the fill-paragraph command. This command will not work + for comments since it will treat the comment characters as words.

+

The Erlang editing mode provides a command that knows about the + Erlang comment structure and can be used to fill text paragraphs + in comments. Ex:

+ + %% This is just a very simple test to show + %% how the Erlang fill + %% paragraph command works. +

Clearly, the text is badly formatted. Instead of formatting this + paragraph line by line, let's try erlang-fill-paragraph by + pressing M-q. The result is:

+ + %% This is just a very simple test to show how the Erlang fill + %% paragraph command works. +
+ +
+ Edit - Comment/Uncomment Region +

C-c C-c will put comment characters at the + beginning of all lines in a marked region. If you want to have + two comment characters instead of one you can do C-u 2 C-c C-c

+

C-c C-u will undo a comment-region command.

+
+ +
+ Edit - Moving the marker + + C-a M-a + (erlang-beginning-of-function) - Move the point to the + beginning of the current or preceding Erlang function. With an + numeric argument (ex C-u 2 C-a M-a) the function + skips backwards over this many Erlang functions. Should the + argument be negative the point is moved to the beginning of a + function below the current function. + M-C-a (erlang-beginning-of-clause) - As + above but move point to the beginning of the current or + preceding Erlang clause. + C-a M-e (erlang-end-of-function) + - Move to the end of the current or following Erlang function. With + an numeric argument (ex C-u 2 C-a M-e) the function + skips backwards over this many Erlang functions. Should the argument + be negative the point is moved to the end of a function below + the current function. + M-C-e (erlang-end-of-clause) - As above + but move point to the end of the current or following Erlang + clause. + +
+ +
+ Edit - Marking + + C-c M-h (erlang-mark-function) - Put the + region around the current Erlang function. The point is + placed in the beginning and the mark at the end of the + function. + M-C-h (erlang-mark-clause) Put the region + around the current Erlang clause. The point is placed in the + beginning and the mark at the end of the function. + +
+ +
+ Edit - Function Header Commands + + C-c C-j (erlang-generate-new-clause) - + Create a new clause in the current Erlang function. The point is + placed between the parentheses of the argument list. + C-c C-y (erlang-clone-arguments) - + Copy the function arguments of the preceding Erlang clause. This + command is useful when defining a new clause with almost the same + argument as the preceding. + +
+ +
+ Edit - Arrows + + +

C-c C-a (erlang-align-arrows) - + aligns arrows after clauses inside a region.

+ + Example: + + sum(L) -> sum(L, 0). + sum([H|T], Sum) -> sum(T, Sum + H); + sum([], Sum) -> Sum. + + becomes: + + sum(L) -> sum(L, 0). + sum([H|T], Sum) -> sum(T, Sum + H); + sum([], Sum) -> Sum." + + +
+ +
+ Syntax highlighting +

The syntax highlighting can be activated from the Erlang menu. There + are four different alternatives:

+ + Off: Normal black and white display. + + Level 1: Function headers, reserved words, comments, + strings, quoted atoms, and character constants will be + colored. + Level 2: The above, attributes, Erlang bif:s, guards, and + words in comments enclosed in single quotes will be colored. + Level 3: The above, variables, records, and macros will + be colored. (This level is also known as the Christmas tree + level.) + +
+ +
+ Tags +

For the tag commands to work it requires that you have + generated a tag file. See Erlang mode users guide

+

+ + M-. (find-tag) - + Find a function definition. The default value is the function name + under the point. + Find Tag (erlang-find-tag) - Like the Elisp-function + `find-tag'. Capable of retrieving Erlang modules. Tags can be + given on the forms `tag', `module:', `module:tag'. + M-+ (erlang-find-next-tag) - Find the + next occurrence of tag. + M-TAB (erlang-complete-tag) - + Perform completion on the tag entered in a tag search. + Completes to the set of names listed in the current tags table. + Tags aprops (tags-apropos) - Display list of all tags in + tags table REGEXP matches. + C-x t s (tags-search) - Search + through all files listed in tags table for match for REGEXP. + Stops when a match is found. + +
+ +
+ Skeletons +

A skeleton is a piece of pre-written code that can be inserted into + the buffer. Erlang mode comes with a set of predefined skeletons. + The skeletons can be accessed either from the Erlang menu of + from commands named tempo-template-erlang-*, as the + skeletons is defined using the standard Emacs package "tempo". + Here follows a brief description of the available skeletons:

+ + Simple skeletons: If, Case, Receive, Receive After, + Receive Loop - Basic code constructs. + + Header elements: Module, Author - These commands insert + lines on the form -module(xxx). and + -author('my@home').. They can be used directly, but are + also used as part of the full headers described below. + Full Headers: Small (minimum requirement), Medium (with + fields for basic information about the module), and Large + Header (medium header with some extra layout structure). + Small Server - skeleton for a simple server not using + OTP. + Application - skeletons for the OTP application + behavior + Supervisor - skeleton for the OTP supervisor behavior + Supervisor Bridge - skeleton for the OTP supervisor bridge + behavior + gen_server - skeleton for the OTP gen_server + behavior + gen_event - skeleton for the OTP gen_event behavior + gen_fsm - skeleton for the OTP gen_fsm behavior + Library module - skeleton for a module that does not + implement a process. + Corba callback - skeleton for a Corba callback module. + Erlang test suite - skeleton for a callback module + for the erlang test server. + +
+ +
+ Shell + + New shell (erlang-shell) - Starts a new Erlang shell. + C-c C-z, (erlang-shell-display ) - + Displays an Erlang shell, or starts a new one if there is no shell + started. + +
+ +
+ Compile + + C-c C-k, (erlang-compile) - + Compiles the Erlang module in the current buffer. + You can also use C-u C-c C-k + to debug compile the module with the debug options + debug_info and export_all. + C-c C-l, (erlang-compile-display) - + Display compilation output. + C-u C-x` Start parsing the compiler output from the + beginning. This command will place the point on the line where + the first error was found. + C-x` (erlang-next-error) - Move the + point on to the next error. The buffer displaying the + compilation errors will be updated so that the current error + will be visible. + +
+ +
+ Man +

On unix you can view the manual pages in emacs. + In order to find the manual pages, the variable `erlang-root-dir' + should be bound to the name of the directory containing the Erlang + installation. The name should not include the final slash. + Practically, you should add a line on the following form to + your ~/.emacs,

+ + (setq erlang-root-dir "/the/erlang/root/dir/goes/here") +
+ +
+ Starting IMenu + + M-x imenu-add-to-menubar RET - This + command will create the IMenu menu containing all the functions + in the current buffer.The command will ask you for a suitable + name for the menu. Not supported by Xemacs. + +
+ +
+ Version + + M-x erlang-version RET - + This command displays the version number of the Erlang editing mode. + Remember to always supply the version number when asking questions + about the Erlang mode. + +
+ + diff --git a/lib/tools/doc/src/erlang_mode_chapter.xml b/lib/tools/doc/src/erlang_mode_chapter.xml new file mode 100644 index 0000000000..cf043e3302 --- /dev/null +++ b/lib/tools/doc/src/erlang_mode_chapter.xml @@ -0,0 +1,251 @@ + + + + +
+ + 20032009 + 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 Erlang mode for Emacs + + + + + erlang_mode_chapter.xml +
+ +
+ Purpose +

The purpose of this user guide is to introduce you to the + Erlang mode for Emacs and gives some relevant background + information of the functions and features. See also Erlang mode reference manual The + purpose of the Erlang mode itself is to facilitate the developing + process for the Erlang programmer.

+
+ +
+ Pre-requisites +

Basic knowledge of Emacs and Erlang/OTP.

+
+ +
+ Elisp +

There are two Elsip modules include in this tool package + for Emacs. There is erlang.el that defines the actual erlang mode + and there is erlang-start.el that makes some nice initializations.

+
+ +
+ Setup on UNIX +

To set up the Erlang Emacs mode on a UNIX systems, edit/create + the file .emacs in the your home directory.

+

Below is a complete example of what should be added to a user's + .emacs provided that OTP is installed in the directory + /usr/local/otp :

+ /emacs" + load-path)) + (setq erlang-root-dir "/usr/local/otp") + (setq exec-path (cons "/usr/local/otp/bin" exec-path)) + (require 'erlang-start) + ]]> +
+ +
+ Setup on Windows +

To set up the Erlang Emacs mode on a Windows systems, + edit/create the file .emacs, the location of the file + depends on the configuration of the system. If the HOME + environment variable is set, Emacs will look for the + .emacs file in the directory indicated by the + HOME variable. If HOME is not set, Emacs + will look for the .emacs file in C:\\ .

+

Below is a complete example of what should be added to a user's + .emacs provided that OTP is installed in the directory + ]]>:

+ /lib/tools-/emacs" + load-path)) + (setq erlang-root-dir "C:/Program Files/erl") + (setq exec-path (cons "C:/Program Files/erl/bin" exec-path)) + (require 'erlang-start) + ]]> + +

In .emacs, the slash character "/" can be used as path + separator. But if you decide to use the backslash character "\\", + please not that you must use double backslashes, since they are + treated as escape characters by Emacs.

+ +
+ +
+ Indentation +

The "Oxford Advanced Learners Dictionary of Current English" says the + following about the word "indent":

+ +

"start (a line of print or writing) farther from + the margin than the others".

+ +

The Erlang mode does, of course, provide this feature. The layout + used is based on the common use of the language.

+

It is strongly recommend to use this feature and avoid to indent lines + in a nonstandard way. Some motivations are:

+ + Code using the same layout is easy to read and maintain. + Since several features of Erlang mode is based on the + standard layout they might not work correctly if a nonstandard layout + is used. + +

The indentation features can be used to reindent large sections + of a file. If some lines use nonstandard indentation they will + be reindented.

+
+ +
+ Editing + + M-x erlang-mode RET - This command activates + the Erlang major mode for the current buffer. When this + mode is active the mode line contain the word "Erlang". + +

When the Erlang mode is correctly installed, it is + automatically activated when a file ending in .erl or + .hrl is opened in Emacs.

+

When a file is saved the name in the -module(). line is + checked against the file name. Should they mismatch Emacs can + change the module specifier so that it matches the file name. + By default, the user is asked before the change is performed.

+

An "electric" command is a character that in addition to just + inserting the character performs some type of action. For + example the ";" character is typed in a situation where is ends + a function clause a new function header is generated. The electric + commands are as follows:

+ + erlang-electric-comma - Insert a comma + character and possibly a new indented line. + erlang-electric-semicolon - Insert a + semicolon character and possibly a prototype for the next line. + erlang-electric-gt - "Insert a '>'-sign + and possible a new indented line. + +

To disable all electric commands set the variable + erlang-electric-commands to the empty list. In short, + place the following line in your .emacs-file:

+ + (setq erlang-electric-commands '()) +
+ +
+ Syntax highlighting +

It is possible for Emacs to use colors when displaying a buffer. By + "syntax highlighting", we mean that syntactic components, for example + keywords and function names, will be colored.

+

The basic idea of syntax highlighting is to make the structure of a + program clearer. For example, the highlighting will make it easier to + spot simple bugs. Have not you ever written a variable in lower-case + only? With syntax highlighting a variable will colored while atoms + will be shown with the normal text color.

+
+ +
+ + Tags +

Tags is a standard Emacs package used to record information + about source files in large development projects. In addition to + listing the files of a project, a tags file normally contains + information about all functions and variables that are defined. + By far, the most useful command of the tags system is its ability + to find the definition of functions in any file in the project. + However the Tags system is not limited to this feature, for + example, it is possible to do a text search in all files in a + project, or to perform a project-wide search and replace.

+

In order to use the Tags system a file named TAGS must be + created. The file can be seen as a database over all functions, + records, and macros in all files in the project. The + TAGS file can be created using two different methods for + Erlang. The first is the standard Emacs utility "etags", the + second is by using the Erlang module tags.

+
+ +
+ Etags +

etags is a program that is part of the Emacs + distribution. It is normally executed from a command line, like + a unix shell or a DOS box.

+

The etags program of fairly modern versions of Emacs and XEmacs + has native support for Erlang. To check if your version does include + this support, issue the command etags --help at a the command + line prompt. At the end of the help text there is a list of supported + languages. Unless Erlang is a member of this list I suggest that you + should upgrade to a newer version of Emacs.

+

As seen in the help text -- unless you have not upgraded your + Emacs yet (well, what are you waiting around here for? Off you go and + upgrade!) -- etags associate the file extensions .erl + and .hrl with Erlang.

+

Basically, the etags utility is ran using the following form:

+ + etags file1.erl file2.erl +

This will create a file named TAGS in the current directory.

+

The etags utility can also read a list of files from its + standard input by supplying a single dash in place of the file + names. This feature is useful when a project consists of a + large number of files. The standard UNIX command find + can be used to generate the list of files, e.g:

+ + find . -name "*.[he]rl" -print | etags - +

The above line will create a TAGS file covering all the + Erlang source files in the current directory, and in the + subdirectories below.

+

Please see the GNU Emacs Manual and the etags man page for more + info.

+
+ +
+ Shell +

The look and feel on an Erlang shell inside Emacs should be the + same as in a normal Erlang shell. There is just one major + difference, the cursor keys will actually move the cursor around + just like in any normal Emacs buffer. The command line history + can be accessed by the following commands:

+ + C-up or M-p + (comint-previous-input) - + Move to the previous line in the input history. + C-down or M-n + (comint-next-input) - Move to the next line in the + input history. + +

If the Erlang shell buffer would be killed the command line + history is saved to a file. The command line history is + automatically retrieved when a new Erlang shell is started.

+
+ +
+ Compilation +

The classic edit-compile-bugfix cycle for Erlang is to edit the + source file in an editor, save it to a file and switch to an + Erlang shell. In the shell the compilation command is given. + Should the compilation fail you have to bring out the editor and + locate the correct line.

+

With the Erlang editing mode the entire edit-compile-bugfix cycle can + be performed without leaving Emacs. Emacs can order Erlang to compile + a file and it can parse the error messages to automatically place the + point on the erroneous lines.

+
+ + diff --git a/lib/tools/doc/src/fascicules.xml b/lib/tools/doc/src/fascicules.xml new file mode 100644 index 0000000000..0678195e07 --- /dev/null +++ b/lib/tools/doc/src/fascicules.xml @@ -0,0 +1,18 @@ + + + + + + User's Guide + + + Reference Manual + + + Release Notes + + + Off-Print + + + diff --git a/lib/tools/doc/src/fprof.xml b/lib/tools/doc/src/fprof.xml new file mode 100644 index 0000000000..8babf50033 --- /dev/null +++ b/lib/tools/doc/src/fprof.xml @@ -0,0 +1,911 @@ + + + + +
+ + 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. + + + + fprof + Raimo Niskanen + nobody + + nobody + + 2001-08-13 + PA1 + fprof.sgml +
+ fprof + A Time Profiling Tool using trace to file for minimal runtime performance impact. + +

This module is used to profile a program + to find out how the execution time is used. + Trace to file is used to minimize + runtime performance impact. +

+

The fprof module uses tracing to collect profiling data, + hence there is no need for special compilation of any module to + be profiled. When it starts tracing, fprof will erase all + previous tracing in the node and set the necessary trace flags + on the profiling target processes as well as local call trace on + all functions in all loaded modules and all modules to be loaded. + fprof erases all tracing in the node when it stops tracing. +

+

fprof presents both own time i.e how much time a + function has used for its own execution, and + accumulated time i.e including called functions. + All presented times are + collected using trace timestamps. fprof tries to collect + cpu time timestamps, if the host machine OS supports it. + Therefore the times may be wallclock times and OS scheduling will + randomly strike all called functions in a presumably fair way. +

+

If, however, the profiling time is short, and the host machine + OS does not support high resolution cpu time measurements, some + few OS schedulings may show up as ridiculously long execution + times for functions doing practically nothing. An example of a + function more or less just composing a tuple in about 100 times + the normal execution time has been seen, and when the tracing + was repeated, the execution time became normal. +

+

Profiling is essentially done in 3 steps:

+ + 1 + Tracing; to file, as mentioned in the previous + paragraph. The trace contains entries for function calls, + returns to function, process scheduling, other process related + (spawn, etc) events, and garbage collection. All trace entries + are timestamped. + 2 + Profiling; the trace file is read, the execution call + stack is simulated, and raw profile data is calculated from + the simulated call stack and the trace timestamps. The profile + data is stored in the fprof server state. During this + step the trace data may be dumped in text format to file or + console. + 3 + Analysing; the raw profile data is sorted, filtered and + dumped in text format either to file or console. The text + format intended to be both readable for a human reader, as + well as parsable with the standard erlang parsing tools. + +

Since fprof uses trace to file, the runtime performance + degradation is minimized, but still far from negligible, + especially for programs that use the filesystem heavily by + themselves. Where you place the trace file is also important, + e.g on Solaris /tmp is usually a good choice since it is + essentially a RAM disk, while any NFS (network) mounted disk is + a bad idea. +

+

fprof can also skip the file step and trace to a tracer + process that does the profiling in runtime. + +

+ + + + start() -> {ok, Pid} | {error, {already_started, Pid}} + Starts the fprof server. + + Pid = pid() + + +

Starts the fprof server. +

+

Note that it seldom + needs to be started explicitly since it is automatically + started by the functions that need a running server. + +

+ + + + stop() -> ok + Same as stop(normal). + +

Same as stop(normal).

+ + + + stop(Reason) -> ok + Stops the fprof server. + + Reason = term() + + +

Stops the fprof server. +

+

The supplied Reason becomes the exit reason for the + server process. Default Any + Reason other than kill sends a request to the + server and waits for it to clean up, reply and exit. If + Reason is kill, the server is bluntly killed. +

+

If the fprof server is not running, this + function returns immediately with the same return value. +

+ +

When the fprof server is stopped the + collected raw profile data is lost.

+ + + + + + apply(Func, Args) -> term() + Same as apply(Func, Args, []). + + Func = function() | {Module, Function} + Args = [term()] + Module = atom() + Function = atom() + + +

Same as apply(Func, Args, []).

+ + + + apply(Module, Function, Args) -> term() + Same as apply({Module, Function}, Args, []). + + Args = [term()] + Module = atom() + Function = atom() + + +

Same as apply({Module, Function}, Args, []).

+ + + + apply(Func, Args, OptionList) -> term() + Calls erlang:apply(Func, Args)surrounded bytrace([start | OptionList])andtrace(stop). + + Func = function() | {Module, Function} + Args = [term()] + OptionList = [Option] + Module = atom() + Function = atom() + Option = continue | start | {procs, PidList} | TraceStartOption + + +

Calls erlang:apply(Func, Args) surrounded by + trace([start, ...]) and + trace(stop). +

+

Some effort is made to keep the trace clean from unnecessary + trace messages; tracing is started and stopped from a spawned + process while the erlang:apply/2 call is made in the + current process, only surrounded by receive and + send statements towards the trace starting + process. The trace starting process exits when not needed + any more. +

+

The TraceStartOption is any option allowed for + trace/1. The options + [start, {procs, [self() | PidList]} | OptList] + are given to trace/1, where OptList is + OptionList with continue, start + and {procs, _} options removed. +

+

The continue option inhibits the call to + trace(stop) and leaves it up to the caller to stop + tracing at a suitable time.

+ + + + apply(Module, Function, Args, OptionList) -> term() + Same as apply({Module, Function}, Args, OptionList). + + Module = atom() + Function = atom() + Args = [term()] + + +

Same as + apply({Module, Function}, Args, OptionList). +

+

OptionList is an option list allowed for + apply/3. + +

+ + + + trace(start, Filename) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as trace([start, {file, Filename}]). + + Reason = term() + + +

Same as trace([start, {file, Filename}]).

+ + + + trace(verbose, Filename) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as trace([start, verbose, {file, Filename}]). + + Reason = term() + + +

Same as + trace([start, verbose, {file, Filename}]).

+ + + + trace(OptionName, OptionValue) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as trace([{OptionName, OptionValue}]). + + OptionName = atom() + OptionValue = term() + Reason = term() + + +

Same as + trace([{OptionName, OptionValue}]).

+ + + + trace(verbose) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as trace([start, verbose]). + + Reason = term() + + +

Same as trace([start, verbose]).

+ + + + trace(OptionName) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as trace([OptionName]). + + OptionName = atom() + Reason = term() + + +

Same as trace([OptionName]).

+ + + + trace({OptionName, OptionValue}) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as trace([{OptionName, OptionValue}]). + + OptionName = atom() + OptionValue = term() + Reason = term() + + +

Same as + trace([{OptionName, OptionValue}]).

+ + + + trace([Option]) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Starts or stops tracing. + + Option = start | stop | {procs, PidSpec} | {procs, [PidSpec]} | verbose | {verbose, bool()} | file | {file, Filename} | {tracer, Tracer} + PidSpec = pid() | atom() + Tracer = pid() | port() + Reason = term() + + +

Starts or stops tracing. +

+

PidSpec and Tracer are used in calls to + erlang:trace(PidSpec, true, [{tracer, Tracer} | Flags]), and Filename is used to call + dbg:trace_port(file, Filename). Please see the + appropriate documentation.

+

Option description:

+ + stop + Stops a running fprof trace and clears all tracing + from the node. Either option stop or start must be + specified, but not both. + start + Clears all tracing from the node and starts a new + fprof trace. Either option start or + stop must be specified, but not both. + verbose| {verbose, bool()} + The options verbose or {verbose, true} + adds some trace flags that fprof does not need, but + that may be interesting for general debugging + purposes. This option is only + allowed with the start option. + cpu_time| {cpu_time, bool()} + The options cpu_time or {cpu_time, true> + makes the timestamps in the trace be in CPU time instead + of wallclock time which is the default. This option is + only allowed with the start option. + {procs, PidSpec}| {procs, [PidSpec]} + Specifies which processes that shall be traced. If + this option is not given, the calling process is + traced. All processes spawned by the traced processes are + also traced. + This option is only allowed with the start option. + file| {file, Filename} + Specifies the filename of the trace. + If the option file is given, or none of these + options are given, the file "fprof.trace" is used. + This option is only allowed with the start option, + but not with the {tracer, Tracer} option. + {tracer, Tracer} + Specifies that trace to process or port shall be done + instead of trace to file. + This option is only allowed with the start option, + but not with the {file, Filename} option. + + + + + + profile() -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as profile([]). + + Reason = term() + + +

Same as profile([]).

+ + + + profile(OptionName, OptionValue) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as profile([{OptionName, OptionValue}]). + + OptionName = atom() + OptionValue = term() + Reason = term() + + +

Same as + profile([{OptionName, OptionValue}]).

+ + + + profile(OptionName) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as profile([OptionName]). + + OptionName = atom() + Reason = term() + + +

Same as profile([OptionName]).

+ + + + profile({OptionName, OptionValue}) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as profile([{OptionName, OptionValue}]). + + OptionName = atom() + OptionValue = term() + Reason = term() + + +

Same as + profile([{OptionName, OptionValue}]).

+ + + + profile([Option]) -> ok | {ok, Tracer} | {error, Reason} | {'EXIT', ServerPid, Reason} + Compiles a trace into raw profile data held by the fprof server. + + Option = file | {file, Filename} | dump | {dump, Dump} | append | start | stop + Dump = pid() | Dumpfile | [] + Tracer = pid() + Reason = term() + + +

Compiles a trace into raw profile data held by the + fprof server. +

+

Dumpfile is used to call file:open/2, + and Filename is used to call + dbg:trace_port(file, Filename). Please see the + appropriate documentation.

+

Option description:

+ + file| {file, Filename} + Reads the file Filename and creates raw + profile data that is stored in RAM by the + fprof server. If the option file is + given, or none of these options are given, the file + "fprof.trace" is read. The call will return when + the whole trace has been + read with the return value ok if successful. + This option is not allowed with the start or + stop options. + dump| {dump, Dump} + Specifies the destination for the trace text dump. If + this option is not given, no dump is generated, if it is + dump the destination will be the + caller's group leader, otherwise the destination + Dump is either the pid of an I/O device or + a filename. And, finally, if the filename is [] - + "fprof.dump" is used instead. + This option is not allowed with the stop option. + append + Causes the trace text dump to be appended to the + destination file. + This option is only allowed with the + {dump, Dumpfile} option. + start + Starts a tracer process that profiles trace data in + runtime. The call will return immediately with the return + value {ok, Tracer} if successful. + This option is not allowed with the stop, + file or {file, Filename} options. + stop + Stops the tracer process that profiles trace data in + runtime. The return value will be value ok if successful. + This option is not allowed with the start, + file or {file, Filename} options. + + + + + + analyse() -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as analyse([]). + + Reason = term() + + +

Same as analyse([]).

+ + + + analyse(OptionName, OptionValue) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as analyse([{OptionName, OptionValue}]). + + OptionName = atom() + OptionValue = term() + Reason = term() + + +

Same as + analyse([{OptionName, OptionValue}]).

+ + + + analyse(OptionName) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as analyse([OptionName]). + + OptionName = atom() + Reason = term() + + +

Same as analyse([OptionName]).

+ + + + analyse({OptionName, OptionValue}) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Same as analyse([{OptionName, OptionValue}]). + + OptionName = atom() + OptionValue = term() + Reason = term() + + +

Same as + analyse([{OptionName, OptionValue}]).

+ + + + analyse([Option]) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason} + Analyses raw profile data in the fprof server. + + Option = dest | {dest, Dest} | append | {cols, Cols} | callers | {callers, bool()} | no_callers | {sort, SortSpec} | totals | {totals, bool()} | details | {details, bool()} | no_details + Dest = pid() | Destfile + Cols = integer() >= 80 + SortSpec = acc | own + Reason = term() + + +

Analyses raw profile data in the + fprof server. If called while there is no raw + profile data available, {error, no_profile} is + returned. +

+

Destfile is used to call file:open/2. + Please see the appropriate documentation.

+

Option description:

+ + dest| {dest, Dest} + Specifies the destination for the analysis. If + this option is not given or it is dest, + the destination will be the caller's group leader, + otherwise the destination Dest is either + the pid() of an I/O device or a filename. + And, finally, if the filename is [] - + "fprof.analysis" is used instead. + append + Causes the analysis to be appended to the + destination file. + This option is only allowed with the + {dest, Destfile} option. + {cols, Cols} + Specifies the number of columns in the analysis text. + If this option is not given the number of columns is set + to 80. + callers| {callers, true} + Prints callers and called information in the + analysis. This is the default. + {callers, false}| no_callers + Suppresses the printing of callers and called + information in the analysis. + {sort, SortSpec} + Specifies if the analysis should be sorted according + to the ACC column, which is the default, or the OWN + column. See + Analysis Format below. + totals| {totals, true} + Includes a section containing call statistics + for all calls regardless of process, in the analysis. + {totals, false} + Supresses the totals section in the analysis, which is + the default. + details| {details, true} + Prints call statistics for each process in the + analysis. This is the default. + {details, false}| no_details + Suppresses the call statistics for each process from + the analysis. + + + + + +
+ + Analysis format +

This section describes the output format of the analyse + command. See analyse/0. +

+

The format is parsable with the standard Erlang parsing tools + erl_scan and erl_parse, file:consult/1 or + io:read/2. The parse format is not explained here - it + should be easy for the interested to try it out. Note that some + flags to analyse/1 will affect the format. +

+

The following example was run on OTP/R8 on Solaris 8, all OTP + internals in this example are very version dependent. +

+

As an example, we will use the following function, that you may + recognise as a slightly modified benchmark function from the + manpage file(3):

+ = 0 -> + {ok, FD} = + file:open(Name, [raw, write, delayed_write, binary]), + if N > 256 -> + ok = file:write(FD, + lists:map(fun (X) -> <> end, + lists:seq(0, 255))), + ok = create_file_slow(FD, 256, N); + true -> + ok = create_file_slow(FD, 0, N) + end, + ok = file:close(FD). + +create_file_slow(FD, M, M) -> + ok; +create_file_slow(FD, M, N) -> + ok = file:write(FD, <>), + create_file_slow(FD, M+1, N).]]> +

Let us have a look at the printout after running:

+ 
+1> fprof:apply(foo, create_file_slow, [junk, 1024]).
+2> fprof:profile().
+3> fprof:analyse().
+

The printout starts with:

+ 
+%% Analysis results:
+{  analysis_options,
+ [{callers, true},
+  {sort, acc},
+  {totals, false},
+  {details, true}]}.
+
+%                                       CNT       ACC       OWN        
+[{ totals,                             9627, 1691.119, 1659.074}].  %%%
+

The CNT column shows the total number of function calls that + was found in the trace. In the ACC column is the total time of + the trace from first timestamp to last. And in the OWN + column is the sum of the execution time in functions found in the + trace, not including called functions. In this case it is very + close to the ACC time since the emulator had practically nothing + else to do than to execute our test program. +

+

All time values in the printout are in milliseconds. +

+

The printout continues:

+ 
+%                                       CNT       ACC       OWN        
+[{ "<0.28.0>",                         9627,undefined, 1659.074}].   %%
+

This is the printout header of one process. The printout + contains only this one process since we did fprof:apply/3 + which traces only the current process. Therefore the CNT and + OWN columns perfectly matches the totals above. The ACC column is + undefined since summing the ACC times of all calls in the process + makes no sense - you would get something like the ACC value from + totals above multiplied by the average depth of the call stack, + or something. +

+

All paragraphs up to the next process header only concerns + function calls within this process. +

+

Now we come to something more interesting:

+ 
+{[{undefined,                             0, 1691.076,    0.030}],     
+ { {fprof,apply_start_stop,4},            0, 1691.076,    0.030},     %
+ [{{foo,create_file_slow,2},              1, 1691.046,    0.103},      
+  {suspend,                               1,    0.000,    0.000}]}.    
+
+{[{{fprof,apply_start_stop,4},            1, 1691.046,    0.103}],     
+ { {foo,create_file_slow,2},              1, 1691.046,    0.103},     %
+ [{{file,close,1},                        1, 1398.873,    0.019},      
+  {{foo,create_file_slow,3},              1,  249.678,    0.029},      
+  {{file,open,2},                         1,   20.778,    0.055},      
+  {{lists,map,2},                         1,   16.590,    0.043},      
+  {{lists,seq,2},                         1,    4.708,    0.017},      
+  {{file,write,2},                        1,    0.316,    0.021}]}.
+

The printout consists of one paragraph per called function. The + function marked with '%' is the one the paragraph + concerns - foo:create_file_slow/2. Above the marked + function are the calling functions - those that has + called the marked, and below are those called by the + marked function. +

+

The paragraphs are per default sorted in decreasing order of + the ACC column for the marked function. The calling list and + called list within one paragraph are also per default sorted in + decreasing order of their ACC column. +

+

The columns are: CNT - the number of times the function + has been called, ACC - the time spent in the + function including called functions, and OWN - the + time spent in the function not including called + functions. +

+

The rows for the calling functions contain statistics + for the marked function with the constraint that only + the occasions when a call was made from the row's + function to the marked function are accounted for. +

+

The row for the marked function simply contains the + sum of all calling rows. +

+

The rows for the called functions contains statistics + for the row's function with the constraint that only the + occasions when a call was made from the marked to the + row's function are accounted for. +

+

So, we see that foo:create_file_slow/2 used very little + time for its own execution. It spent most of its time in + file:close/1. The function foo:create_file_slow/3 + that writes 3/4 of the file contents is the second biggest time + thief. +

+

We also see that the call to file:write/2 that writes + 1/4 of the file contents takes very little time in itself. What + takes time is to build the data (lists:seq/2 and + lists:map/2). +

+

The function 'undefined' that has called + fprof:apply_start_stop/4 is an unknown function because that + call was not recorded in the trace. It was only recorded + that the execution returned from + fprof:apply_start_stop/4 to some other function above in + the call stack, or that the process exited from there. +

+

Let us continue down the printout to find:

+ 
+{[{{foo,create_file_slow,2},              1,  249.678,    0.029},      
+  {{foo,create_file_slow,3},            768,    0.000,   23.294}],     
+ { {foo,create_file_slow,3},            769,  249.678,   23.323},     %
+ [{{file,write,2},                      768,  220.314,   14.539},      
+  {suspend,                              57,    6.041,    0.000},      
+  {{foo,create_file_slow,3},            768,    0.000,   23.294}]}.
+

If you compare with the code you will see there also that + foo:create_file_slow/3 was called only from + foo:create_file_slow/2 and itself, and called only + file:write/2, note the number of calls to + file:write/2. But here we see that suspend was + called a few times. This is a pseudo function that indicates + that the process was suspended while executing in + foo:create_file_slow/3, and since there is no + receive or erlang:yield/0 in the code, it must be + Erlang scheduling suspensions, or the trace file driver + compensating for large file write operations (these are regarded + as a schedule out followed by a schedule in to the same process). +

+

+

Let us find the suspend entry:

+ 
+{[{{file,write,2},                       53,    6.281,    0.000},      
+  {{foo,create_file_slow,3},             57,    6.041,    0.000},      
+  {{prim_file,drv_command,4},            50,    4.582,    0.000},      
+  {{prim_file,drv_get_response,1},       34,    2.986,    0.000},      
+  {{lists,map,2},                        10,    2.104,    0.000},      
+  {{prim_file,write,2},                  17,    1.852,    0.000},      
+  {{erlang,port_command,2},              15,    1.713,    0.000},      
+  {{prim_file,drv_command,2},            22,    1.482,    0.000},      
+  {{prim_file,translate_response,2},     11,    1.441,    0.000},      
+  {{prim_file,'-drv_command/2-fun-0-',1},  15,    1.340,    0.000},      
+  {{lists,seq,4},                         3,    0.880,    0.000},      
+  {{foo,'-create_file_slow/2-fun-0-',1},   5,    0.523,    0.000},      
+  {{erlang,bump_reductions,1},            4,    0.503,    0.000},      
+  {{prim_file,open_int_setopts,3},        1,    0.165,    0.000},      
+  {{prim_file,i32,4},                     1,    0.109,    0.000},      
+  {{fprof,apply_start_stop,4},            1,    0.000,    0.000}],     
+ { suspend,                             299,   32.002,    0.000},     %
+ [ ]}.
+

We find no particulary long suspend times, so no function seems + to have waited in a receive statement. Actually, + prim_file:drv_command/4 contains a receive statement, but + in this test program, the message lies in the process receive + buffer when the receive statement is entered. We also see that + the total suspend time for the test run is small. +

+

The suspend pseudo function has got an OWN time of + zero. This is to prevent the process total OWN time from + including time in suspension. Whether suspend time is really ACC + or OWN time is more of a philosophical question. +

+

Now we look at another interesting pseudo function, + garbage_collect:

+ 
+{[{{prim_file,drv_command,4},            25,    0.873,    0.873},      
+  {{prim_file,write,2},                  16,    0.692,    0.692},      
+  {{lists,map,2},                         2,    0.195,    0.195}],     
+ { garbage_collect,                      43,    1.760,    1.760},     %
+ [ ]}.
+

Here we see that no function distinguishes itself considerably, + which is very normal. +

+

The garbage_collect pseudo function has not got an OWN + time of zero like suspend, instead it is equal to the ACC + time. +

+

Garbage collect often occurs while a process is suspended, but + fprof hides this fact by pretending that the suspended + function was first unsuspended and then garbage + collected. Otherwise the printout would show + garbage_collect being called from suspend but not + not which function that might have caused the garbage + collection. +

+

Let us now get back to the test code:

+ 
+{[{{foo,create_file_slow,3},            768,  220.314,   14.539},      
+  {{foo,create_file_slow,2},              1,    0.316,    0.021}],     
+ { {file,write,2},                      769,  220.630,   14.560},     %
+ [{{prim_file,write,2},                 769,  199.789,   22.573},      
+  {suspend,                              53,    6.281,    0.000}]}.
+

Not unexpectedly, we see that file:write/2 was called + from foo:create_file_slow/3 and + foo:create_file_slow/2. The number of calls in each case as + well as the used time are also just confirms the previous results. +

+

We see that file:write/2 only calls + prim_file:write/2, but let us refrain from digging into the + internals of the kernel application. +

+

But, if we nevertheless do dig down we find + the call to the linked in driver that does the file operations + towards the host operating system:

+ 
+{[{{prim_file,drv_command,4},           772, 1458.356, 1456.643}],     
+ { {erlang,port_command,2},             772, 1458.356, 1456.643},     %
+ [{suspend,                              15,    1.713,    0.000}]}.
+

This is 86 % of the total run time, and as we saw before it + is the close operation the absolutely biggest contributor. We + find a comparison ratio a little bit up in the call stack:

+ 
+{[{{prim_file,close,1},                   1, 1398.748,    0.024},      
+  {{prim_file,write,2},                 769,  174.672,   12.810},      
+  {{prim_file,open_int,4},                1,   19.755,    0.017},      
+  {{prim_file,open_int_setopts,3},        1,    0.147,    0.016}],     
+ { {prim_file,drv_command,2},           772, 1593.322,   12.867},     %
+ [{{prim_file,drv_command,4},           772, 1578.973,   27.265},      
+  {suspend,                              22,    1.482,    0.000}]}.
+

The time for file operations in the linked in driver + distributes itself as 1 % for open, 11 % for write and 87 % for + close. All data is probably buffered in the operating system + until the close. +

+

The unsleeping reader may notice that the ACC times for + prim_file:drv_command/2 and + prim_file:drv_command/4 is not equal between the + paragraphs above, even though it is easy to believe that + prim_file:drv_command/2 is just a passthrough function. +

+

The missing time can be found in the paragraph + for prim_file:drv_command/4 where it is evident that not + only prim_file:drv_command/2 is called but also a fun: +

+ 
+{[{{prim_file,drv_command,2},           772, 1578.973,   27.265}],     
+ { {prim_file,drv_command,4},           772, 1578.973,   27.265},     %
+ [{{erlang,port_command,2},             772, 1458.356, 1456.643},      
+  {{prim_file,'-drv_command/2-fun-0-',1}, 772,   87.897,   12.736},      
+  {suspend,                              50,    4.582,    0.000},      
+  {garbage_collect,                      25,    0.873,    0.873}]}.
+

And some more missing time can be explained by the fact that + prim_file:open_int/4 both calls + prim_file:drv_command/2 directly as well as through + prim_file:open_int_setopts/3, which complicates the + picture. +

+ 
+{[{{prim_file,open,2},                    1,   20.309,    0.029},      
+  {{prim_file,open_int,4},                1,    0.000,    0.057}],     
+ { {prim_file,open_int,4},                2,   20.309,    0.086},     %
+ [{{prim_file,drv_command,2},             1,   19.755,    0.017},      
+  {{prim_file,open_int_setopts,3},        1,    0.360,    0.032},      
+  {{prim_file,drv_open,2},                1,    0.071,    0.030},      
+  {{erlang,list_to_binary,1},             1,    0.020,    0.020},      
+  {{prim_file,i32,1},                     1,    0.017,    0.017},      
+  {{prim_file,open_int,4},                1,    0.000,    0.057}]}.    
+.
+.
+.
+{[{{prim_file,open_int,4},                1,    0.360,    0.032},      
+  {{prim_file,open_int_setopts,3},        1,    0.000,    0.016}],     
+ { {prim_file,open_int_setopts,3},        2,    0.360,    0.048},     %
+ [{suspend,                               1,    0.165,    0.000},      
+  {{prim_file,drv_command,2},             1,    0.147,    0.016},      
+  {{prim_file,open_int_setopts,3},        1,    0.000,    0.016}]}.
+
+ +
+ Notes +

The actual supervision of execution times is in itself a + CPU intensive activity. A message is written on the trace file + for every function call that is made by the profiled code. +

+

The ACC time calculation is sometimes difficult to make + correct, since it is difficult to define. This happens + especially when a function occurs in several instances in the + call stack, for example by calling itself perhaps through other + functions and perhaps even non-tail recursively. +

+

To produce sensible results, fprof tries not to charge + any function more than once for ACC time. The instance highest + up (with longest duration) in the call stack is chosen. +

+

Sometimes a function may unexpectedly waste a lot (some 10 ms + or more depending on host machine OS) of OWN (and ACC) time, even + functions that does practically nothing at all. The problem may + be that the OS has chosen to schedule out the + Erlang runtime system process for a while, and if the OS does + not support high resolution cpu time measurements + fprof will use wallclock time for its calculations, and + it will appear as functions randomly burn virtual machine time.

+
+ +
+ See Also +

dbg(3), eprof(3), erlang(3), + io(3), + Tools User's Guide

+
+ + diff --git a/lib/tools/doc/src/fprof_chapter.xml b/lib/tools/doc/src/fprof_chapter.xml new file mode 100644 index 0000000000..3f40d93f40 --- /dev/null +++ b/lib/tools/doc/src/fprof_chapter.xml @@ -0,0 +1,141 @@ + + + + +
+ + 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. + + + + fprof - The File Trace Profiler + Raimo Niskanen + nobody + + nobody + no + 2001-08-14 + PA1 + fprof_chapter.xml +
+

fprof is a profiling tool that can be used to get a picture of + how much processing time different functions consumes and in which + processes. +

+

fprof uses tracing with timestamps to collect profiling + data. Therfore there is no need for special compilation of any + module to be profiled. +

+

fprof presents wall clock times from the host machine OS, + with the assumption that OS scheduling will randomly load the + profiled functions in a fair way. Both own time i.e the + time used by a function for its own execution, and + accumulated time i.e execution time including called + functions. +

+

Profiling is essentially done in 3 steps:

+ + 1 + Tracing; to file, as mentioned in the previous paragraph. + 2 + Profiling; the trace file is read and raw profile data is + collected into an internal RAM storage on the node. During + this step the trace data may be dumped in text format to file + or console. + 3 + Analysing; the raw profile data is sorted and dumped + in text format either to file or console. + +

Since fprof uses trace to file, the runtime performance + degradation is minimized, but still far from negligible, + especially not for programs that use the filesystem heavily + by themselves. Where you place the trace file is also important, + e.g on Solaris /tmp is usually a good choice, + while any NFS mounted disk is a lousy choice. +

+

Fprof can also skip the file step and trace to a tracer process + of its own that does the profiling in runtime. +

+

The following sections show some examples of how to profile with + Fprof. See also the reference manual + fprof(3). +

+ +
+ Profiling from the source code +

If you can edit and recompile the source code, it is convenient + to insert fprof:trace(start) and + fprof:trace(stop) before and after the code to be + profiled. All spawned processes are also traced. If you want + some other filename than the default try + fprof:trace(start, "my_fprof.trace"). +

+

Then read the trace file and create the raw profile data with + fprof:profile(), or perhaps + fprof:profile(file, "my_fprof.trace") for non-default + filename. +

+

Finally create an informative table dumped on the console with + fprof:analyse(), or on file with + fprof:analyse(dest, []), or perhaps even + fprof:analyse([{dest, "my_fprof.analysis"}, {cols, 120}]) + for a wider listing on non-default filename. +

+

See the fprof(3) manual page + for more options and arguments to the functions + trace, + profile + and + analyse. +

+
+ +
+ Profiling a function +

If you have one function that does the task that you want to + profile, and the function returns when the profiling should + stop, it is convenient to use + fprof:apply(Module, Function, Args) and related for the + tracing step. +

+

If the tracing should continue after the function returns, for + example if it is a start function that spawns processes to be + profiled, you can use + fprof:apply(M, F, Args, [continue | OtherOpts]). + The tracing has to be stopped at a suitable later time using + fprof:trace(stop). +

+
+ +
+ Immediate profiling +

It is also possible to trace immediately into the profiling + process that creates the raw profile data, that is to short + circuit the tracing and profiling steps so that the filesystem + is not used. +

+

Do something like this:

+ 
+{ok, Tracer} = fprof:profile(start),
+fprof:trace([start, {tracer, Tracer}]),
+%% Code to profile
+fprof:trace(stop);
+

This puts less load on the filesystem, but much more on the + Erlang runtime system. +

+
+ + diff --git a/lib/tools/doc/src/instrument.xml b/lib/tools/doc/src/instrument.xml new file mode 100644 index 0000000000..12877994de --- /dev/null +++ b/lib/tools/doc/src/instrument.xml @@ -0,0 +1,432 @@ + + + + +
+ + 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. + + + + instrument + Arndt Jonasson + Torbjörn Johnsson + 1 + Björn Gustavsson + + 98-04-01 + PA1 + instrument.sgml +
+ instrument + Analysis and Utility Functions for Instrumentation + +

The module instrument contains support for studying the resource + usage in an Erlang runtime system. Currently, only the allocation of memory can + be studied.

+ +

Note that this whole module is experimental, and the representations + used as well as the functionality is likely to change in the future.

+

The instrument module interface was slightly changed in + Erlang/OTP R9C.

+ +

To start an Erlang runtime system with instrumentation, use the + +Mi* set of command-line arguments to the erl command (see + the erts_alloc(3) and erl(1) man pages).

+

The basic object of study in the case of memory allocation is a memory + allocation map. A memory allocation map contains a list of descriptors + for each allocated memory block. Currently, a descriptor is a 4-tuple

+ 
+        {TypeNo, Address, Size, PidDesc}
+

where TypeNo is the memory block type number, Address + is its place in memory, and Size is its size, in bytes. + PidDesc is either a tuple {X,Y,Z} identifying the + process which was executing when the block was allocated, or + undefined if no process was executing. The pid tuple + {X,Y,Z} can be transformed into a real pid by usage of the + c:pid/3 function.

+

Various details about memory allocation:

+

Memory blocks are allocated both on the heap segment and on other memory + segments. This can cause the instrumentation functionality to report + very large holes. Currently the instrumentation functionality doesn't + provide any support for distinguishing between holes between memory + segments, and holes between allocated blocks inside memory segments. + The current size of the process cannot be obtained from within Erlang, + but can be seen with one of the system statistics tools, e.g., + ps or top. The Solaris utility pmap can be + useful. It reports currently mapped memory segments.

+

Overhead for instrumentation: When the emulator has been started with + the "+Mim true" + flag, each block is preceded by a 24 bytes large + header on a 32-bit machine and a 48 bytes large header on a 64-bit + machine. When the emulator has been started with the + "+Mis true" + flag, each block is preceded by an 8 bytes large header. These are the header + sizes used by the Erlang 5.3/OTP R9C emulator. Other versions of the + emulator may use other header sizes. The function + block_header_size/1 + can be used for retrieving the header size used for a specific memory + allocation map. The time overhead for managing the instrumentation + data is small.

+

Sizes presented by the instrumentation functionality are (by the + emulator) requested sizes, i.e. neither instrumentation headers nor + headers used by allocators are included.

+ + + + allocator_descr(MemoryData, TypeNo) -> AllocDescr | invalid_type | "unknown" + Returns a allocator description + + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + TypeNo = int() + AllocDescr = atom() | string() + + +

Returns the allocator description of the allocator that + manages memory blocks of type number TypeNo used in + MemoryData. + Valid TypeNos are in the range returned by + type_no_range/1 on + this specific memory allocation map. If TypeNo is an + invalid integer, invalid_type is returned.

+ + + + block_header_size(MemoryData) -> int() + Returns the memory block header size used by the emulator that generated the memory allocation map + + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + + + +

Returns the memory block header size used by the + emulator that generated the memory allocation map. The block + header size may differ between different emulators.

+ + + + class_descr(MemoryData, TypeNo) -> ClassDescr | invalid_type | "unknown" + Returns a allocator description + + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + TypeNo = int() + ClassDescr = atom() | string() + + +

Returns the class description of the class that + the type number TypeNo used in MemoryData belongs + to. + Valid TypeNos are in the range returned by + type_no_range/1 on + this specific memory allocation map. If TypeNo is an + invalid integer, invalid_type is returned.

+ + + + descr(MemoryData) -> DescrMemoryData + Replace type numbers in memory allocation map with type descriptions + + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + DescrMemoryData = {term(), DescrAllocList} + DescrAllocList = [DescrDesc] + DescrDesc = {TypeDescr, int(), int(), DescrPidDesc} + TypeDescr = atom() | string() + DescrPidDesc = pid() | undefined + + +

Returns a memory allocation map where the type numbers (first + element of Desc) have been replaced by type descriptions, + and pid tuples (fourth element of Desc) have been + replaced by real pids.

+ + + + holes(MemoryData) -> ok + Print out the sizes of unused memory blocks + + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + + +

Prints out the size of each hole (i.e., the space between + allocated blocks) on the terminal. NOTE: Really large holes + are probably holes between memory segments. + The memory allocation map has to be sorted (see + sort/1).

+ + + + mem_limits(MemoryData) -> {Low, High} + Return lowest and highest memory address used + + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + Low = High = int() + + +

Returns a tuple {Low, High} indicating + the lowest and highest address used. + The memory allocation map has to be sorted (see + sort/1).

+ + + + memory_data() -> MemoryData | false + Return the current memory allocation map + + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + + +

Returns MemoryData (a the memory allocation map) + if the emulator has been started with the "+Mim true" + command-line argument; otherwise, false. NOTE:memory_data/0 blocks execution of other processes while + the data is collected. The time it takes to collect the data can + be substantial.

+ + + + memory_status(StatusType) -> [StatusInfo] | false + Return current memory allocation status + + StatusType = total | allocators | classes | types + StatusInfo = {About, [Info]} + About = atom() + Info = {InfoName, Current, MaxSinceLast, MaxEver} + InfoName = sizes|blocks + Current = int() + MaxSinceLast = int() + MaxEver = int() + + +

Returns a list of StatusInfo if the emulator has been + started with the "+Mis true" or "+Mim true" + command-line argument; otherwise, false.

+

See the + read_memory_status/1 + function for a description of the StatusInfo term.

+ + + + read_memory_data(File) -> MemoryData | {error, Reason} + Read memory allocation map + + File = string() + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + + + +

Reads a memory allocation map from the file File and + returns it. The file is assumed to have been created by + store_memory_data/1. The error codes are the same as for + file:consult/1.

+ + + + read_memory_status(File) -> MemoryStatus | {error, Reason} + Read memory allocation status from a file + + File = string() + MemoryStatus = [{StatusType, [StatusInfo]}] + StatusType = total | allocators | classes | types + StatusInfo = {About, [Info]} + About = atom() + Info = {InfoName, Current, MaxSinceLast, MaxEver} + InfoName = sizes|blocks + Current = int() + MaxSinceLast = int() + MaxEver = int() + + + +

Reads memory allocation status from the file File and + returns it. The file is assumed to have been created by + store_memory_status/1. The error codes are the same as + for file:consult/1.

+

When StatusType is allocators, About is + the allocator that the information is about. When + StatusType is types, About is + the memory block type that the information is about. Memory + block types are not described other than by their name and may + vary between emulators. When StatusType is classes, + About is the memory block type class that information is + presented about. Memory block types are classified after their + use. Currently the following classes exist:

+ + process_data + Erlang process specific data. + binary_data + Erlang binaries. + atom_data + Erlang atoms. + code_data + Erlang code. + system_data + Other data used by the system + +

When InfoName is sizes, Current, + MaxSinceLast, and MaxEver are, respectively, current + size, maximum size since last call to + store_memory_status/1 or memory_status/1 with the + specific StatusType, and maximum size since the emulator + was started. When InfoName is blocks, Current, + MaxSinceLast, and MaxEver are, respectively, current + number of blocks, maximum number of blocks since last call to + store_memory_status/1 or memory_status/1 with the + specific StatusType, and maximum number of blocks since the + emulator was started.

+

NOTE:A memory block is accounted for at + "the first level" allocator. E.g. fix_alloc allocates its + memory pools via ll_alloc. When a fix_alloc block + is allocated, neither the block nor the pool in which it resides + are accounted for as memory allocated via ll_alloc even + though it is.

+ + + + sort(MemoryData) -> MemoryData + Sort the memory allocation list + + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + + + +

Sorts a memory allocation map so that the addresses are in + ascending order.

+ + + + store_memory_data(File) -> true|false + Store the current memory allocation map on a file + + File = string() + + +

Stores the current memory allocation map on the file + File. Returns true if the emulator has been + started with the "+Mim true" command-line argument, and + the map was successfuly stored; otherwise, false. The + contents of the file can later be read using + read_memory_data/1. + NOTE:store_memory_data/0 blocks execution of + other processes while the data is collected. The time it takes + to collect the data can be substantial.

+ + + + store_memory_status(File) -> true|false + Store the current memory allocation status on a file + + File = string() + + +

Stores the current memory status on the file + File. Returns true if the emulator has been + started with the "+Mis true", or "+Mim true" + command-line arguments, and the data was successfuly stored; + otherwise, false. The contents of the file can later be + read using + read_memory_status/1.

+ + + + sum_blocks(MemoryData) -> int() + Return the total amount of memory used + + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + + +

Returns the total size of the memory blocks in the list.

+ + + + type_descr(MemoryData, TypeNo) -> TypeDescr | invalid_type + Returns a type description + + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + TypeNo = int() + TypeDescr = atom() | string() + + +

Returns the type description of a type number used in + MemoryData. + Valid TypeNos are in the range returned by + type_no_range/1 on + this specific memory allocation map. If TypeNo is an + invalid integer, invalid_type is returned.

+ + + + type_no_range(MemoryData) -> {Min, Max} + Returns the memory block type numbers + + MemoryData = {term(), AllocList} + AllocList = [Desc] + Desc = {int(), int(), int(), PidDesc} + PidDesc = {int(), int(), int()} | undefined + Min = int() + Max = int() + + + +

Returns the memory block type number range used in + MemoryData. When the memory allocation map was generated + by an Erlang 5.3/OTP R9C or newer emulator, all integers T + that satisfy Min <= T <= Max are + valid type numbers. When the memory allocation map was generated + by a pre Erlang 5.3/OTP R9C emulator, all integers in the + range are not valid type numbers.

+ + + + +
+ See Also +

erts_alloc(3), + erl(1)

+
+ + diff --git a/lib/tools/doc/src/make.dep b/lib/tools/doc/src/make.dep new file mode 100644 index 0000000000..11fa090d6f --- /dev/null +++ b/lib/tools/doc/src/make.dep @@ -0,0 +1,33 @@ +# ---------------------------------------------------- +# >>>> Do not edit this file <<<< +# This file was automaticly generated by +# /home/otp/bin/docdepend +# ---------------------------------------------------- + + +# ---------------------------------------------------- +# TeX files that the DVI file depend on +# ---------------------------------------------------- + +book.dvi: book.tex cover.tex cover_chapter.tex cprof.tex \ + cprof_chapter.tex eprof.tex erlang_mode.tex \ + erlang_mode_chapter.tex fprof.tex fprof_chapter.tex \ + instrument.tex make.tex part.tex ref_man.tex \ + tags.tex xref.tex xref_chapter.tex + +# ---------------------------------------------------- +# Source inlined when transforming from source to LaTeX +# ---------------------------------------------------- + +book.tex: ref_man.xml + +cprof.tex: ../../../../system/doc/definitions/term.defs + +xref.tex: ../../../../system/doc/definitions/term.defs + +# ---------------------------------------------------- +# Pictures that the DVI file depend on +# ---------------------------------------------------- + +book.dvi: venn1.ps venn2.ps + diff --git a/lib/tools/doc/src/make.xml b/lib/tools/doc/src/make.xml new file mode 100644 index 0000000000..f13514d99f --- /dev/null +++ b/lib/tools/doc/src/make.xml @@ -0,0 +1,144 @@ + + + + +
+ + 1996 + 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. + + + make + + + + +
+ make + A Make Utility for Erlang + +

The module make provides a set of functions similar to + the UNIX type Make functions.

+ + + + all() -> up_to_date | error + all(Options) -> up_to_date | error + Compile a set of modules. + + Options = [Option] +  Option = noexec | load | netload | <compiler option> + + +

This function first looks in the current working directory + for a file named Emakefile (see below) specifying the + set of modules to compile and the compile options to use. If + no such file is found, the set of modules to compile + defaults to all modules in the current working + directory.

+

Traversing the set of modules, it then recompiles every module for + which at least one of the following conditions apply:

+ + there is no object file, or + the source file has been modified since it was last compiled, + or, + an include file has been modified since the source file was + last compiled. + +

As a side effect, the function prints the name of each module it + tries to compile. If compilation fails for a module, the make + procedure stops and error is returned.

+

Options is a list of make- and compiler options. + The following make options exist:

+ + noexec

+ + No execution mode. Just prints the name of each module that needs + to be compiled. + load

+ + Load mode. Loads all recompiled modules. + netload

+ + Net load mode. Loads all recompiled modules an all known nodes. + +

All items in Options that are not make options are assumed + to be compiler options and are passed as-is to + compile:file/2. Options defaults to [].

+ + + + files(ModFiles) -> up_to_date | error + files(ModFiles, Options) -> up_to_date | error + Compile a set of modules. + + ModFiles = [Module | File] +  Module = atom() +  File = string() + Options = [Option] +  Option = noexec | load | netload | <compiler option> + + +

files/1,2 does exactly the same thing as all/0,1 but + for the specified ModFiles, which is a list of module or + file names. The file extension .erl may be omitted.

+

The Emakefile (if it exists) in the current + directory is searched for compiler options for each module. If + a given module does not exist in Emakefile or if + Emakefile does not exist, the module is still compiled.

+ + + + +
+ Emakefile +

make:all/0,1 and make:files/1,2 looks in the + current working directory for a file named Emakefile. If + it exists, Emakefile should contain elements like this:

+ +Modules. +{Modules,Options}. +

Modules is an atom or a list of atoms. It can be +

+ + a module name, e.g. file1 + a module name in another directory, + e.g. ../foo/file3 + a set of modules specified with a wildcards, + e.g. 'file*' + a wildcard indicating all modules in current directory, + i.e. '*' + a list of any of the above, + e.g. ['file*','../foo/file3','File4'] + +

Options is a list of compiler options. +

+

Emakefile is read from top to bottom. If a module + matches more than one entry, the first match is valid. For + example, the following Emakefile means that file1 + shall be compiled with the options + [debug_info,{i,"../foo"}], while all other files in the + current directory shall be compiled with only the + debug_info flag.

+ +{'file1',[debug_info,{i,"../foo"}]}. +{'*',[debug_info]}. +

+
+ + diff --git a/lib/tools/doc/src/note.gif b/lib/tools/doc/src/note.gif new file mode 100644 index 0000000000..6fffe30419 Binary files /dev/null and b/lib/tools/doc/src/note.gif differ diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml new file mode 100644 index 0000000000..59f600145e --- /dev/null +++ b/lib/tools/doc/src/notes.xml @@ -0,0 +1,475 @@ + + + + +
+ + 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. + + + + Tools Release Notes + + + + + notes.xml +
+

This document describes the changes made to the Tools application.

+ +
Tools 2.6.5 + +
Fixed Bugs and Malfunctions + + +

The coverage analysis tool cover has been + improved when it comes to handling list and bit string + comprehensions (a counter for each qualifier), bit syntax + expressions (the Value and Size expressions), and try + expressions (the body called Exprs in the Reference + Manual). A few (not all) situations where several + expressions are put on the same line are also handled + better than before.

+

Own Id: OTP-8188 Aux Id: seq11397

+ + +

When loading Cover compiled code on remote nodes + running code in the loaded module, a badarg + failure was sometimes the result. This bug has been fixed.

+

Own Id: OTP-8270 Aux Id: seq11423

+ + +

The short-circuit operators andalso and + orelse are now handled correctly by the coverage + analysis tool cover (it is no longer checked + that the second argument returns a Boolean value.)

+

Own Id: OTP-8273

+ + +
+ +
+ +
Tools 2.6.4 + +
Fixed Bugs and Malfunctions + + +

cover now properly escapes greater-than and + less-than characters in comments in HTML reports. (Thanks + to Magnus Henoch.)

+

+ Own Id: OTP-7939

+ + +
+ +
+ +
Tools 2.6.3 + +
Improvements and New Features + + +

+ xref:start/1 does now allow anonymous XREF processes to + be started

+

+ Own Id: OTP-7831

+ + +
+ +
+ +
Tools 2.6.2 + +
Fixed Bugs and Malfunctions + + +

A bug in the Xref scanner has been fixed.

+

+ Own Id: OTP-7423

+ + +

A bug in Fprof where the function 'undefined' appeared + to call 'undefined' has been corrected.

+

+ Own Id: OTP-7509

+ + +
+ +
+ +
Tools 2.6.1 + +
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

+ + +

tuple_size/1 and byte_size/1 have been + substituted for size/1.

+

+ Own Id: OTP-7009

+ + +

The coverage analysis tool cover now handles + the short-circuit Boolean expressions andalso/2 + and orelse/2 properly.

+

+ Own Id: OTP-7095

+ + +
+ +
+ +
Tools 2.6 + +
Fixed Bugs and Malfunctions + + +

+ The cover tool could use huge amounts of memory + when used in a distributed system.

+

+ Own Id: OTP-6758

+ + +
+ +
+ + +
+ Tools 2.5.5 + +
+ Fixed Bugs and Malfunctions + + +

Missing buffer-local declaration in erlang.el has been + added. Before this fix there could arise problems in + other emacs modes after visiting a buffer using the + erlang mode.

+

Own Id: OTP-6721

+ + +

Key-map for 'backward-delete-char-untabif updated to work + properly with Xemacs.

+

Own Id: OTP-6723

+ + +
+ +
+ Improvements and New Features + + +

Minor updates of Xref.

+

Own Id: OTP-6586

+ + +

Minor Makefile changes.

+

Own Id: OTP-6689 Aux Id: OTP-6742

+ + +

"C-u C-c C-k" now does a compile with both "debug_info" + and "export_all".

+

Own Id: OTP-6741

+ + +
+
+ +
+ Tools 2.5.4.1 + +
+ Improvements and New Features + + +

Changes due to internal interface changes in the erts + application which are needed at compile-time. No + functionality has been changed.

+

Own Id: OTP-6611 Aux Id: OTP-6580

+ + +
+
+ +
+ Tools 2.5.4 + +
+ Fixed Bugs and Malfunctions + + +

Made change to support the function erlang-find-tag for + xemacs and emacs-21.

+

Own Id: OTP-6512

+ + +
+ +
+ Improvements and New Features + + +

Minor updates of xref for future compatibility.

+

Own Id: OTP-6513

+ + +
+
+ +
+ Tools 2.5.3 + +
+ Fixed Bugs and Malfunctions + + +

eprof did not work reliably in the SMP emulator, + because the trace receiver process could not process the + trace messages fast enough. Therefore, eprof now + blocks the other schedulers while profiling.

+

Own Id: OTP-6373

+ + +
+
+ +
+ Tools 2.5.2 + +
+ Fixed Bugs and Malfunctions + + +

Fprof traces could become truncated for the SMP emulator. + This bug has now been corrected.

+

Own Id: OTP-6246

+ + +
+
+ +
+ Tools 2.5.1 + +
+ Fixed Bugs and Malfunctions + + +

eprof now works somewhat better in the SMP emulator.

+

Own Id: OTP-6152

+ + +
+
+ +
+ Tools 2.5 + +
+ Fixed Bugs and Malfunctions + + +

Fixed some bugs in make:

+

make:files/1,2 can now handle a file in another + directory as argument, similar to make:all/0,1.

+

When specifying a file name including the .erl + extension in Emakefile, make:all/0,1 looked + for the object code in the wrong place.

+

When specifying a file name including the .erl + extension in Emakefile and some compile options + for the file, make:files/0,1 did not use the + options as it should do.

+

Own Id: OTP-6057 Aux Id: seq10299

+ + +

cover: When cover:stop() was called, + the cover compiled code was not unloaded (as stated in + the documentation) but simply marked as 'old'. This + meant that processes lingering in (or with funs + referencing to) the cover compiled code would survive + even when the cover server and its ETS tables was + terminated.

+

Now the cover compiled code is unloaded, meaning that + processes lingering in/with references to it will be + killed when cover:stop is called, instead of + later crashing with badarg when trying to bump + counters in ETS tables no longer existing.

+ + +
+ +
+ Improvements and New Features + + +

Replaced call to deprecated function + file:file_info/1 with call to + filelib:is_dir/1 and filelib:is_regular/1 + in tags.erl.

+

Own Id: OTP-6079

+ + +
+
+ +
+ Tools 2.4.7 + +
+ Fixed Bugs and Malfunctions + + +

A bug in fprof profiling causing erroneous + inconsistent trace failure has been corrected.

+

Own Id: OTP-5922 Aux Id: seq10203

+ + +
+
+ +
+ Tools 2.4.6 + +
+ Fixed Bugs and Malfunctions + + +

Emacs: erlang-man-function and + erlang-man-module used a pattern matching to find + the requested module that sometimes yielded unexpected + results. For example, erlang-man-module file would + display the man page for CosFileTransfer_File.

+

Own Id: OTP-5746 Aux Id: seq10096

+ + +

Some compiler warnings and Dialyzer warnings were + eliminated in the Tools application.

+

When tracing to a port (which fprof does), + there could be fake schedule out/schedule in messages + sent for a process that had exited.

+

Own Id: OTP-5757

+ + +
+
+ +
+ Tools 2.4.5 + +
+ Fixed Bugs and Malfunctions + + +

The cross reference tool xref did not handle the new + fun M:F/A construct properly. This problem has been + fixed.

+

Own Id: OTP-5653

+ + +
+
+ +
+ Tools 2.4.4 + +
+ Fixed Bugs and Malfunctions + + +

The cover tool did not escape '<' and '>' not + being part of HTML tags in HTML log files.

+

Own Id: OTP-5588

+ + +
+
+ +
+ Tools 2.4.3 + +
+ Improvements and New Features + + +

It is now possible to encrypt the debug information in + beam files, to help keep the source code secret. See + compile(3) for how to provide the key for encrypting, + and beam_lib(3) for how to provide the key for + decryption so that tools such as Debugger, xref, or + cover can be used.

+

The beam_lib:chunks/2 functions now accepts an + additional chunk type 'compile_info' to retrieve + the compilation information directly as a term. (Thanks + to Tobias Lindahl.)

+

Own Id: OTP-5460 Aux Id: seq9787

+ + +
+
+ +
+ Tools 2.4.2 + +
+ Fixed Bugs and Malfunctions + + +

The cover tool could not analyze empty modules on + module level.

+

Own Id: OTP-5418

+ + +
+
+ +
+ Tools 2.4.1 + +
+ Fixed Bugs and Malfunctions + + +

The xref analysis locals_not_used could + return too many functions. This problem has been fixed.

+

Own Id: OTP-5071

+ + +

The cover tool could not always compile parse + transformed modules. This problem has been fixed.

+

Own Id: OTP-5305

+ + +
+
+ + diff --git a/lib/tools/doc/src/notes_history.xml b/lib/tools/doc/src/notes_history.xml new file mode 100644 index 0000000000..ef5ce1c03d --- /dev/null +++ b/lib/tools/doc/src/notes_history.xml @@ -0,0 +1,243 @@ + + + + +
+ + 2006 + 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. + + + Tools Release Notes + + + + +
+ +
+ Tools 2.4 + +
+ Fixed Bugs and Malfunctions + + +

The Erlang Emacs mode now properly handles strings that + have $ or ^ as the last character.

+

Own Id: OTP-4697

+ + +

xref: The unresolved arity (-1) is now recognized + in analyses and queries.

+

Own Id: OTP-4778

+ + +

cover does no longer hang if an interface function + is called on a remote node - it returns + {error,not_main_node}.

+

Own Id: OTP-5031

+ + +

fprof: Time spent in the last function in a chain, + i.e. a function which did not call another function, and + the time when a process was scheduled out, was charged on + the above function. This resulted in own time in many + cases being bigger than acc time since the time a process + was scheduled out was charged on the function from which + the process was scheduled out. This is now corrected.

+

Own Id: OTP-5073

+ + +

Previous patch from open source messed up \\M-q so part of + that patch was backed out.

+

Own Id: OTP-5074

+ + +

cover: Added "Exclude Included Functions". If + "real code" is included in a modules which is cover + compiled, there will be no bumps for lines in the + included file. Earlier this would cause faulty bumps for + lines in the module, i.e. if the code was on line 4 in + the included file it would produce a bump for line 4 in + the module. Lines in included files are now just + disregarded.

+

Own Id: OTP-5122

+ + +
+ +
+ Improvements and New Features + + +

Added support for try-catch to the Erlang mode for Emacs. + However there are still some known problems with some of + the more advanced variants especially including separate + of-clauses.

+

Own Id: OTP-4594

+ + +

Improvments for support of Emacs 21 contributed by Dave + Love. The bulk of the changes are actually cosmetic + commentary/doc fixes. The significant ones make it play + better with Emacs 21 with up-to-date facilities. In + particular, support for compilation error messages from + an inferior erl (as opposed to batch compilation) works + in the released Emacs 21, and currently with the + development Emacs.

+

Own Id: OTP-5019

+ + +

Added a skeletons for an Erlang test-suite for both the + ts-frontend and the ct-frontend (this frontend is + Ericsson internal). Also altered some of the old + skeletons to get a uniform look and feel.

+

Own Id: OTP-5058

+ + +

The Erlang mode for Emacs now supports the new guard + is_boolean.

+

Own Id: OTP-5059

+ + +

cover: Adjustments to handle new syntax of + try-catch.

+

Own Id: OTP-5154

+ + +
+
+ +
+ Tools 2.3 + +
+ Fixed Bugs and Malfunctions + + +

Totally rewritten the interface for WebCover. Can now + compile both .erl and .beam files and + export/import cover data.

+

Own Id: OTP-4706

+ + +

cover does no longer report coverage on lines which + are not executed.

+

Own Id: OTP-4734

+ + +

Erlang mode for Emacs: Fixed so that the generation of new + function clauses works also for guarded functions.

+

Own Id: OTP-3697

+ + +

Erlang mode for Emacs: Fixed so that you do not get + the error message "unbalanced parenthesis" when indenting + correct code including bit syntax.

+

Own Id: OTP-4526

+ + +

Erlang mode for Emacs: The guard function is now + colored.

+

Own Id: OTP-4533

+ + +

Erlang mode for Emacs: Indentation of macros is handled + correctly in all cases.

+

Own Id: OTP-4561, OTP-4687

+ + +

is_* guards are now colored.

+

Own Id: OTP-4562

+ + +

Erlang mode for Emacs: Now handles the fact that a function + argument may be a guard expression. (That is useful when + writing test case code.)

+

Own Id: OTP-4579

+ + +

Erlang mode for Emacs: Keywords andalso and + orelse are now colored.

+

Own Id: OTP-4580

+ + +

Erlang mode for Emacs: Fixed bug in function that calculates + the arity of an Erlang function.

+

Own Id: OTP-4581

+ + +
+ +
+ Improvements and New Features + + +

Added functions cover:start(Nodes) and + cover:stop(Nodes). Cover compiled modules will be + loaded on all nodes added with cover:start(Nodes). + cover:stop(Nodes) will collect coverage data from + the stopped nodes and merge it with data collected on + the main (controller) node.

+

cover:analyse/1,2,3 and + cover:analyse_to_file/1,2,3 will also collect data + from all nodes before analysing.

+

Own Id: OTP-4177

+ + +

The module attribute tag deprecated is used by + xref to find calls to deprecated functions. + The m/1, d/1, and analyze/2,3 functions + have been updated to return calls to deprecated functions. + See also xref(3) for more details.

+

Own Id: OTP-4695

+ + +

Added functions cover:compile_beam/1 and + cover:compile_beam_directory/0,1. These functions use + abstract code from existing beam files when cover compiling.

+

Added option html to + cover:analyse_to_file/1,2,3. Instead of plain text, + a HTML file is generated with all uncovered lines colored + red.

+

Added functions cover:export/1,2 and + cover:import/1. These functions can be used to export + current coverage data to a file, and then import the data + in a later session. Data can be exported for one single + module or for all currently cover compiled modules.

+

Own Id: OTP-4702

+ + +

Erlang mode for Emacs: Added function + erlang-align-arrows.

+

Own Id: OTP-4737

+ + +

The interface for the instrument module has been + slightly changed. Also some new functionality has been + added. See instrument(3) for more information.

+

(*** POTENTIAL INCOMPATIBILITY ***)

+

Own Id: OTP-4761

+ + Aux Id: OTP-4534

+ + +
+
+ + diff --git a/lib/tools/doc/src/part.xml b/lib/tools/doc/src/part.xml new file mode 100644 index 0000000000..3e02086b80 --- /dev/null +++ b/lib/tools/doc/src/part.xml @@ -0,0 +1,74 @@ + + + + +
+ + 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. + + + + Tools User's Guide + + + + +
+ +

The Tools application contains a number of stand-alone + tools, which are useful when developing Erlang programs.

+ + cover + A coverage analysis tool for Erlang. + cprof + A profiling tool that shows how many + times each function is called. Uses a kind of local call trace + breakpoints containing counters to achieve very low runtime + performance degradation. + emacs - (erlang.el and erlang-start.el) + This package provides support + for the programming language Erlang in Emacs. The package provides an + editing mode with lots of bells and whistles, compilation + support, and it makes it possible for the user to start Erlang + shells that run inside Emacs. + eprof + A time profiling tool; measure how time is used in Erlang + programs. Erlang programs. Predecessor of fprof (see below). + fprof + Another Erlang profiler; measure how time is used in your + Erlang programs. Uses trace to file to minimize runtime + performance impact, and displays time for calling and called + functions. + instrument + Utility functions for obtaining and analysing resource usage + in an instrumented Erlang runtime system. + make + A make utility for Erlang similar to UNIX make. + tags + A tool for generating Emacs TAGS files from Erlang source + files. + xref + A cross reference tool. Can be used to check dependencies + between functions, modules, applications and releases. + + + + + + + + + diff --git a/lib/tools/doc/src/part_notes.xml b/lib/tools/doc/src/part_notes.xml new file mode 100644 index 0000000000..b8b67889c2 --- /dev/null +++ b/lib/tools/doc/src/part_notes.xml @@ -0,0 +1,38 @@ + + + + +
+ + 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. + + + + Tools Release Notes + + + + +
+ +

The Tools application contains a number of stand-alone + tools, which are useful when developing Erlang programs.

+

For information about older versions, see + Release Notes History.

+ + + + diff --git a/lib/tools/doc/src/part_notes_history.xml b/lib/tools/doc/src/part_notes_history.xml new file mode 100644 index 0000000000..b40b530c02 --- /dev/null +++ b/lib/tools/doc/src/part_notes_history.xml @@ -0,0 +1,38 @@ + + + + +
+ + 2006 + 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. + + + Tools Release Notes History + + + + +
+ +

The Tools application contains a number of stand-alone + tools, which are useful when developing Erlang programs.

+ + + + diff --git a/lib/tools/doc/src/ref_man.xml b/lib/tools/doc/src/ref_man.xml new file mode 100644 index 0000000000..aea74e3746 --- /dev/null +++ b/lib/tools/doc/src/ref_man.xml @@ -0,0 +1,77 @@ + + + + +
+ + 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. + + + + Tools Reference Manual + + + + +
+ +

The Tools application contains a number of stand-alone + tools, which are useful when developing Erlang programs.

+ + cover + A coverage analysis tool for Erlang. + cprof + A profiling tool that shows how many + times each function is called. Uses a kind of local call trace + breakpoints containing counters to achieve very low runtime + performance degradation. + erlang.el- Erlang mode for Emacs + Editing support such as indentation, syntax highlighting, + electric commands, module name verification, comment support + including paragraph filling, skeletons, tags support and more + for erlang source code. + eprof + A time profiling tool; measure how time is used in Erlang + programs. Predecessor of fprof (see below). + fprof + Another Erlang profiler; measure how time is used in your + Erlang programs. Uses trace to file to minimize runtime + performance impact, and displays time for calling and called + functions. + instrument + Utility functions for obtaining and analysing resource usage + in an instrumented Erlang runtime system. + make + A make utility for Erlang similar to UNIX make. + tags + A tool for generating Emacs TAGS files from Erlang source + files. + xref + A cross reference tool. Can be used to check dependencies + between functions, modules, applications and releases. + + + + + + + + + + + + + diff --git a/lib/tools/doc/src/tags.xml b/lib/tools/doc/src/tags.xml new file mode 100644 index 0000000000..5e1da25acf --- /dev/null +++ b/lib/tools/doc/src/tags.xml @@ -0,0 +1,147 @@ + + + + +
+ + 1998 + 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. + + + tags + Anders Lindgren + + 1 + 98-03-11 + A + tags.sgml +
+ tags + Generate Emacs TAGS file from Erlang source files + +

A TAGS file is used by Emacs to find function and variable + definitions in any source file in large projects. This module can + generate a TAGS file from Erlang source files. It recognises + functions, records, and macro definitions.

+ + + + file(File [, Options]) + Create a TAGSfile for the file File. + +

Create a TAGS file for the file File.

+ + + + files(FileList [, Options]) + Create a TAGS file for the files in the listFileList. + +

Create a TAGS file for the files in the list + FileList.

+ + + + dir(Dir [, Options]) + Create a TAGS file for all files in directoryDir. + +

Create a TAGS file for all files in directory + Dir.

+ + + + dirs(DirList [, Options]) + Create a TAGS file for all files in any directory inDirList. + +

Create a TAGS file for all files in any directory in + DirList.

+ + + + subdir(Dir [, Options]) + Descend recursively down the directory Dirand create a TAGSfile based on all files found. + +

Descend recursively down the directory Dir and + create a TAGS file based on all files found.

+ + + + subdirs(DirList [, Options]) + Descend recursively down all the directories inDirListand create a TAGSfile based on all files found. + +

Descend recursively down all the directories in + DirList and create a TAGS file based on all + files found.

+ + + + root([Options]) + Create a TAGSfile covering all files in the Erlang distribution. + +

Create a TAGS file covering all files in + the Erlang distribution.

+ + + + +
+ OPTIONS +

The functions above have an optional argument, Options. It is a + list which can contain the following elements:

+ + {outfile, NameOfTAGSFile} Create a TAGS file named + NameOfTAGSFile. + + {outdir, NameOfDirectory} Create a file named + TAGS in the directory NameOfDirectory. + +

The default behaviour is to create a file named TAGS in the current + directory.

+
+ +
+ Examples + + +

tags:root([{outfile, "root.TAGS"}]).

+

+

This command will create a file named root.TAGS in the current + directory. The file will contain references to all Erlang source + files in the Erlang distribution.

+ + +

tags:files(["foo.erl", "bar.erl", "baz.erl"], [{outdir, "../projectdir"}]).

+

+

Here we create file named TAGS placed it in the directory + ../projectdir. The file contains information about the + functions, records, and macro definitions of the three files.

+ + +
+ +
+ SEE ALSO + + Richard M. Stallman. GNU Emacs Manual, chapter "Editing Programs", + section "Tag Tables". Free Software Foundation, 1995. + + Anders Lindgren. The Erlang editing mode for Emacs. Ericsson, + 1998. + +
+ + diff --git a/lib/tools/doc/src/venn1.fig b/lib/tools/doc/src/venn1.fig new file mode 100644 index 0000000000..a826756047 --- /dev/null +++ b/lib/tools/doc/src/venn1.fig @@ -0,0 +1,63 @@ +#FIG 3.2 +Portrait +Center +Inches +Letter +100.00 +Single +-2 +1200 2 +6 4368 1485 7027 4139 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 3177.742 2812.000 4570 2137 4725 2812 4570 3487 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 9043.057 2812.000 5400 4112 5175 2812 5400 1512 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 2307.694 2812.000 6003 1512 6225 2812 6003 4112 +1 3 0 1 -1 7 0 0 -1 0.000 1 0.0000 5700 2812 1327 1327 5700 2812 4800 1837 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 1 + 6681 3706 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 6675 1912 6675 3712 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 7 0 0 2 + 4368 2806 6675 2806 +2 1 0 1 0 0 100 0 1 0.000 0 0 -1 0 0 2 + 6675 3149 6985 3149 +-6 +6 1275 3075 3000 4800 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 563.250 3905.000 1434 3485 1530 3905 1434 4325 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 23.692 3905.000 2326 3096 2464 3905 2326 4714 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 4217.432 3905.000 1950 4714 1810 3905 1950 3096 +6 1275 3675 2775 4200 +6 2026 3679 2251 4129 +6 2026 3679 2251 4129 +4 0 0 100 0 0 8 0.0000 4 75 180 2078 3794 XU\001 +4 0 0 100 0 0 8 0.0000 4 75 165 2071 3944 and\001 +4 0 0 100 0 0 8 0.0000 4 75 165 2078 4093 LU\001 +-6 +-6 +4 0 0 100 0 0 8 0.0000 4 75 165 1594 3934 LU\001 +4 0 0 100 0 0 8 0.0000 4 75 180 2634 3934 XU\001 +4 0 0 100 0 0 8 0.0000 4 75 180 1337 3934 UU\001 +-6 +1 3 0 1 -1 7 0 0 -1 0.000 1 0.0000 2137 3905 826 826 2137 3905 1577 3298 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 1 + 2747 4461 +-6 +6 1275 825 3000 2850 +6 2760 1516 2820 2006 +4 0 0 100 0 0 8 0.0000 4 75 90 2760 1576 U\001 +4 0 0 100 0 0 8 0.0000 4 75 75 2760 2006 B\001 +-6 +1 3 0 1 -1 7 0 0 -1 0.000 1 0.0000 2115 1665 826 826 2115 1665 1555 1058 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 1 + 2725 2221 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 2722 1105 2722 2225 +2 1 0 1 0 0 100 0 1 0.000 0 0 -1 0 0 2 + 2722 1875 2917 1875 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 7 0 0 2 + 1286 1665 2722 1665 +4 0 0 100 0 0 11 0.0000 4 105 645 1830 2785 Definition\001 +4 0 0 100 0 0 8 0.0000 4 75 90 2022 1338 X\001 +4 0 0 100 0 0 8 0.0000 4 75 75 2022 2085 L\001 +-6 +4 0 0 100 0 0 11 0.0000 4 105 240 2025 5025 Use\001 +4 0 0 101 0 0 11 0.0000 4 105 1155 5127 4544 Definition and Use\001 diff --git a/lib/tools/doc/src/venn1.gif b/lib/tools/doc/src/venn1.gif new file mode 100644 index 0000000000..e40bcfb8ab Binary files /dev/null and b/lib/tools/doc/src/venn1.gif differ diff --git a/lib/tools/doc/src/venn1.ps b/lib/tools/doc/src/venn1.ps new file mode 100644 index 0000000000..9c12048728 --- /dev/null +++ b/lib/tools/doc/src/venn1.ps @@ -0,0 +1,205 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: venn1.ps +%%Creator: fig2dev Version 3.2 Patchlevel 1 +%%CreationDate: Tue Sep 19 19:28:28 2000 +%%For: hasse@helios (Hans Bolinder) +%%Orientation: Portrait +%%BoundingBox: 0 0 347 253 +%%Pages: 0 +%%BeginSetup +%%EndSetup +%%Magnification: 1.0000 +%%EndComments +/$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 +-76.0 302.0 translate +1 -1 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 + /DrawEllipse { + /endangle exch def + /startangle exch def + /yrad exch def + /xrad exch def + /y exch def + /x exch def + /savematrix mtrx currentmatrix def + x y tr xrad yrad sc 0 0 1 startangle endangle arc + closepath + savematrix setmatrix + } def + +/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def +/$F2psEnd {$F2psEnteredState restore end} def +%%EndProlog + +$F2psBegin +10 setmiterlimit +n -1000 6025 m -1000 -1000 l 8035 -1000 l 8035 6025 l cp clip + 0.06000 0.06000 sc +/Times-Roman ff 165.00 scf sf +5127 4544 m +gs 1 -1 sc (Definition and Use) col0 sh gr +% Polyline +7.500 slw +n 6675 3149 m 6985 3149 l gs 0.95 setgray ef gr gs col0 s gr +/Times-Roman ff 120.00 scf sf +2078 3794 m +gs 1 -1 sc (XU) col0 sh gr +/Times-Roman ff 120.00 scf sf +2071 3944 m +gs 1 -1 sc (and) col0 sh gr +/Times-Roman ff 120.00 scf sf +2078 4093 m +gs 1 -1 sc (LU) col0 sh gr +/Times-Roman ff 120.00 scf sf +1594 3934 m +gs 1 -1 sc (LU) col0 sh gr +/Times-Roman ff 120.00 scf sf +2634 3934 m +gs 1 -1 sc (XU) col0 sh gr +/Times-Roman ff 120.00 scf sf +1337 3934 m +gs 1 -1 sc (UU) col0 sh gr +/Times-Roman ff 120.00 scf sf +2760 1576 m +gs 1 -1 sc (U) col0 sh gr +/Times-Roman ff 120.00 scf sf +2760 2006 m +gs 1 -1 sc (B) col0 sh gr +% Polyline +n 2722 1875 m 2917 1875 l gs 0.95 setgray ef gr gs col0 s gr +/Times-Roman ff 165.00 scf sf +1830 2785 m +gs 1 -1 sc (Definition) col0 sh gr +/Times-Roman ff 120.00 scf sf +2022 1338 m +gs 1 -1 sc (X) col0 sh gr +/Times-Roman ff 120.00 scf sf +2022 2085 m +gs 1 -1 sc (L) col0 sh gr +/Times-Roman ff 165.00 scf sf +2025 5025 m +gs 1 -1 sc (Use) col0 sh gr +% Arc +gs n 3177.7 2812.0 1547.3 -25.9 25.9 arc +gs col-1 s gr + gr + +% Arc +gs n 9043.1 2812.0 3868.1 160.4 -160.4 arc +gs col-1 s gr + gr + +% Arc +gs n 2307.7 2812.0 3917.3 -19.4 19.4 arc +gs col-1 s gr + gr + +% Ellipse +n 5700 2812 1327 1327 0 360 DrawEllipse gs col-1 s gr + +% Polyline +n 6677 3706 m 6685 3706 l gs col-1 s gr +% Polyline +n 6675 1912 m 6675 3712 l gs col-1 s gr +% Polyline +n 4368 2806 m 6675 2806 l gs col-1 s gr +% Arc +gs n 563.2 3905.0 966.8 -25.8 25.8 arc +gs col-1 s gr + gr + +% Arc +gs n 23.7 3905.0 2440.3 -19.4 19.4 arc +gs col-1 s gr + gr + +% Arc +gs n 4217.4 3905.0 2407.4 160.4 -160.4 arc +gs col-1 s gr + gr + +% Ellipse +n 2137 3905 826 826 0 360 DrawEllipse gs col-1 s gr + +% Polyline +n 2743 4461 m 2751 4461 l gs col-1 s gr +% Ellipse +n 2115 1665 826 826 0 360 DrawEllipse gs col-1 s gr + +% Polyline +n 2721 2221 m 2729 2221 l gs col-1 s gr +% Polyline +n 2722 1105 m 2722 2225 l gs col-1 s gr +% Polyline +n 1286 1665 m 2722 1665 l gs col-1 s gr +$F2psEnd +rs diff --git a/lib/tools/doc/src/venn2.fig b/lib/tools/doc/src/venn2.fig new file mode 100644 index 0000000000..3694c12f0c --- /dev/null +++ b/lib/tools/doc/src/venn2.fig @@ -0,0 +1,97 @@ +#FIG 3.2 +Portrait +Center +Inches +Letter +100.00 +Single +-2 +1200 2 +6 3392 953 5034 3329 +6 3392 953 5034 2595 +6 3392 953 5034 2595 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 2652.489 1773.500 3518 1357 3613 1774 3518 2190 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 6306.956 1773.000 4028 2575 3891 1774 4028 971 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 2105.283 1773.000 4402 971 4538 1774 4402 2575 +1 1 0 1 -1 7 0 0 -1 0.000 1 0.0000 4214 1774 820 821 4214 1774 3659 1171 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 1 + 4821 2325 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 4816 1217 4816 2329 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 7 0 0 2 + 3392 1769 4816 1769 +2 1 0 1 0 0 100 0 1 0.000 0 0 -1 0 0 2 + 4816 1982 5008 1982 +-6 +2 3 0 0 0 0 101 0 5 0.000 0 0 -1 0 0 36 + 4026 977 4011 1025 3996 1072 3981 1120 3966 1177 3954 1225 + 3944 1272 3929 1327 3919 1412 3909 1477 3899 1540 3894 1592 + 3894 1642 3891 1697 3889 1742 3889 1770 3394 1767 3396 1717 + 3399 1665 3409 1610 3424 1555 3439 1502 3464 1440 3489 1390 + 3516 1340 3551 1292 3584 1250 3631 1200 3679 1150 3731 1110 + 3801 1065 3869 1030 3931 1005 3986 982 4009 980 4026 977 +-6 +4 0 0 101 0 0 11 0.0000 4 105 525 3965 3044 X - XU\001 +4 0 0 101 0 0 11 0.0000 4 150 1110 3688 3299 exports_not_used\001 +-6 +6 5850 938 7560 3329 +6 5884 938 7526 2580 +6 5884 938 7526 2580 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 5144.489 1758.500 6010 1342 6105 1759 6010 2175 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 8798.956 1758.000 6520 2560 6383 1759 6520 956 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 4597.283 1758.000 6894 956 7030 1759 6894 2560 +1 1 0 1 -1 7 0 0 -1 0.000 1 0.0000 6706 1759 820 821 6706 1759 6151 1156 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 1 + 7313 2310 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 7308 1202 7308 2314 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 7 0 0 2 + 5884 1754 7308 1754 +2 1 0 1 0 0 100 0 1 0.000 0 0 -1 0 0 2 + 7308 1967 7500 1967 +-6 +2 3 0 0 0 0 101 0 5 0.000 0 0 -1 0 0 22 + 6107 1757 6104 1802 6099 1855 6094 1902 6084 1960 6072 2010 + 6062 2052 6049 2092 6032 2122 6019 2160 6007 2180 5984 2140 + 5962 2095 5944 2057 5929 2007 5909 1947 5899 1892 5892 1835 + 5889 1800 5889 1775 5889 1755 6107 1757 +2 3 0 0 0 0 101 0 5 0.000 0 0 -1 0 0 32 + 7309 1757 7309 2315 7287 2340 7259 2365 7234 2390 7199 2412 + 7164 2440 7124 2465 7092 2482 7054 2502 7014 2520 6974 2535 + 6934 2547 6897 2557 6909 2510 6924 2457 6942 2407 6954 2357 + 6967 2297 6979 2247 6992 2192 6999 2142 7009 2095 7012 2045 + 7019 1990 7022 1945 7027 1900 7029 1855 7029 1805 7032 1765 + 7029 1752 7309 1757 +-6 +4 0 0 101 0 0 11 0.0000 4 135 1470 6000 3014 L * (UU + (XU - LU))\001 +4 0 0 101 0 0 11 0.0000 4 150 1800 5850 3299 locals_not_used (simplified)\001 +-6 +6 900 900 2550 3600 +6 900 900 2550 2625 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 160.489 1780.500 1026 1364 1121 1781 1026 2197 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 3814.956 1780.000 1536 2582 1399 1781 1536 978 +5 1 0 1 -1 7 0 0 -1 0.000 0 0 0 0 -386.717 1780.000 1910 978 2046 1781 1910 2582 +1 1 0 1 -1 7 0 0 -1 0.000 1 0.0000 1722 1781 820 821 1722 1781 1167 1178 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 1 + 2329 2332 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 2324 1224 2324 2336 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 7 0 0 2 + 900 1776 2324 1776 +2 1 0 1 0 0 100 0 1 0.000 0 0 -1 0 0 2 + 2324 1989 2516 1989 +-6 +2 3 0 0 0 0 101 0 5 0.000 0 0 -1 0 0 27 + 1395 1777 1400 1857 1405 1935 1407 2010 1417 2070 1425 2137 + 1440 2215 1455 2297 1470 2365 1490 2437 1510 2495 1527 2547 + 1535 2580 1600 2595 1672 2605 1772 2602 1865 2595 1947 2572 + 2005 2555 2075 2525 2150 2482 2207 2442 2260 2400 2295 2367 + 2325 2332 2325 1775 1395 1777 +2 3 0 0 0 0 101 0 5 0.000 0 0 -1 0 0 16 + 2330 1222 2365 1265 2402 1317 2437 1382 2477 1455 2500 1517 + 2520 1585 2532 1645 2540 1712 2542 1780 2540 1842 2535 1907 + 2527 1957 2517 1990 2325 1987 2330 1222 +4 0 0 101 0 0 11 0.0000 4 105 780 1331 3044 XU - X - B\001 +4 0 0 101 0 0 11 0.0000 4 150 1260 1113 3314 undefined_functions\001 +4 0 0 100 0 0 10 0.0000 4 135 1005 1275 3525 (modules mode)\001 +-6 diff --git a/lib/tools/doc/src/venn2.gif b/lib/tools/doc/src/venn2.gif new file mode 100644 index 0000000000..4cfea24646 Binary files /dev/null and b/lib/tools/doc/src/venn2.gif differ diff --git a/lib/tools/doc/src/venn2.ps b/lib/tools/doc/src/venn2.ps new file mode 100644 index 0000000000..198ccf285c --- /dev/null +++ b/lib/tools/doc/src/venn2.ps @@ -0,0 +1,284 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: venn2b.eps +%%Creator: fig2dev Version 3.2.3 Patchlevel +%%CreationDate: Tue Oct 9 11:12:20 2001 +%%For: hasse@ulmo2 (Hans Bolinder) +%%BoundingBox: 0 0 409 157 +%%Magnification: 1.0000 +%%EndComments +/$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 +newpath 0 157 moveto 0 0 lineto 409 0 lineto 409 157 lineto closepath clip newpath +% Fill background color +0 0 moveto 409 0 lineto 409 157 lineto 0 157 lineto +closepath 1.00 1.00 1.00 setrgbcolor fill + +-53.0 212.0 translate +1 -1 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 +/reencdict 12 dict def /ReEncode { reencdict begin +/newcodesandnames exch def /newfontname exch def /basefontname exch def +/basefontdict basefontname findfont def /newfont basefontdict maxlength dict def +basefontdict { exch dup /FID ne { dup /Encoding eq +{ exch dup length array copy newfont 3 1 roll put } +{ exch newfont 3 1 roll put } ifelse } { pop pop } ifelse } forall +newfont /FontName newfontname put newcodesandnames aload pop +128 1 255 { newfont /Encoding get exch /.notdef put } for +newcodesandnames length 2 idiv { newfont /Encoding get 3 1 roll put } repeat +newfontname newfont definefont pop end } def +/isovec [ +8#055 /minus 8#200 /grave 8#201 /acute 8#202 /circumflex 8#203 /tilde +8#204 /macron 8#205 /breve 8#206 /dotaccent 8#207 /dieresis +8#210 /ring 8#211 /cedilla 8#212 /hungarumlaut 8#213 /ogonek 8#214 /caron +8#220 /dotlessi 8#230 /oe 8#231 /OE +8#240 /space 8#241 /exclamdown 8#242 /cent 8#243 /sterling +8#244 /currency 8#245 /yen 8#246 /brokenbar 8#247 /section 8#250 /dieresis +8#251 /copyright 8#252 /ordfeminine 8#253 /guillemotleft 8#254 /logicalnot +8#255 /hypen 8#256 /registered 8#257 /macron 8#260 /degree 8#261 /plusminus +8#262 /twosuperior 8#263 /threesuperior 8#264 /acute 8#265 /mu 8#266 /paragraph +8#267 /periodcentered 8#270 /cedilla 8#271 /onesuperior 8#272 /ordmasculine +8#273 /guillemotright 8#274 /onequarter 8#275 /onehalf +8#276 /threequarters 8#277 /questiondown 8#300 /Agrave 8#301 /Aacute +8#302 /Acircumflex 8#303 /Atilde 8#304 /Adieresis 8#305 /Aring +8#306 /AE 8#307 /Ccedilla 8#310 /Egrave 8#311 /Eacute +8#312 /Ecircumflex 8#313 /Edieresis 8#314 /Igrave 8#315 /Iacute +8#316 /Icircumflex 8#317 /Idieresis 8#320 /Eth 8#321 /Ntilde 8#322 /Ograve +8#323 /Oacute 8#324 /Ocircumflex 8#325 /Otilde 8#326 /Odieresis 8#327 /multiply +8#330 /Oslash 8#331 /Ugrave 8#332 /Uacute 8#333 /Ucircumflex +8#334 /Udieresis 8#335 /Yacute 8#336 /Thorn 8#337 /germandbls 8#340 /agrave +8#341 /aacute 8#342 /acircumflex 8#343 /atilde 8#344 /adieresis 8#345 /aring +8#346 /ae 8#347 /ccedilla 8#350 /egrave 8#351 /eacute +8#352 /ecircumflex 8#353 /edieresis 8#354 /igrave 8#355 /iacute +8#356 /icircumflex 8#357 /idieresis 8#360 /eth 8#361 /ntilde 8#362 /ograve +8#363 /oacute 8#364 /ocircumflex 8#365 /otilde 8#366 /odieresis 8#367 /divide +8#370 /oslash 8#371 /ugrave 8#372 /uacute 8#373 /ucircumflex +8#374 /udieresis 8#375 /yacute 8#376 /thorn 8#377 /ydieresis] def +/Times-Roman /Times-Roman-iso isovec ReEncode + /DrawEllipse { + /endangle exch def + /startangle exch def + /yrad exch def + /xrad exch def + /y exch def + /x exch def + /savematrix mtrx currentmatrix def + x y tr xrad yrad sc 0 0 1 startangle endangle arc + closepath + savematrix setmatrix + } def + +/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def +/$F2psEnd {$F2psEnteredState restore end} def + +$F2psBegin +%%Page: 1 1 +10 setmiterlimit + 0.06000 0.06000 sc +% Polyline +n 4026 977 m 4011 1025 l 3996 1072 l 3981 1120 l 3966 1177 l 3954 1225 l + 3944 1272 l 3929 1327 l 3919 1412 l 3909 1477 l 3899 1540 l + 3894 1592 l 3894 1642 l 3891 1697 l 3889 1742 l 3889 1770 l + 3394 1767 l 3396 1717 l 3399 1665 l 3409 1610 l 3424 1555 l + 3439 1502 l 3464 1440 l 3489 1390 l 3516 1340 l 3551 1292 l + 3584 1250 l 3631 1200 l 3679 1150 l 3731 1110 l 3801 1065 l + 3869 1030 l 3931 1005 l 3986 982 l 4009 980 l + cp gs 0.75 setgray ef gr +/Times-Roman-iso ff 165.00 scf sf +3965 3044 m +gs 1 -1 sc (X - XU) col0 sh gr +/Times-Roman-iso ff 165.00 scf sf +3688 3299 m +gs 1 -1 sc (exports_not_used) col0 sh gr +% Polyline +n 6107 1757 m 6104 1802 l 6099 1855 l 6094 1902 l 6084 1960 l 6072 2010 l + 6062 2052 l 6049 2092 l 6032 2122 l 6019 2160 l 6007 2180 l + 5984 2140 l 5962 2095 l 5944 2057 l 5929 2007 l 5909 1947 l + 5899 1892 l 5892 1835 l 5889 1800 l 5889 1775 l 5889 1755 l + + cp gs 0.75 setgray ef gr +% Polyline +n 7309 1757 m 7309 2315 l 7287 2340 l 7259 2365 l 7234 2390 l 7199 2412 l + 7164 2440 l 7124 2465 l 7092 2482 l 7054 2502 l 7014 2520 l + 6974 2535 l 6934 2547 l 6897 2557 l 6909 2510 l 6924 2457 l + 6942 2407 l 6954 2357 l 6967 2297 l 6979 2247 l 6992 2192 l + 6999 2142 l 7009 2095 l 7012 2045 l 7019 1990 l 7022 1945 l + 7027 1900 l 7029 1855 l 7029 1805 l 7032 1765 l 7029 1752 l + + cp gs 0.75 setgray ef gr +/Times-Roman-iso ff 165.00 scf sf +6000 3014 m +gs 1 -1 sc (L * \(UU + \(XU - LU\)\)) col0 sh gr +/Times-Roman-iso ff 165.00 scf sf +5850 3299 m +gs 1 -1 sc (locals_not_used \(simplified\)) col0 sh gr +% Polyline +n 1395 1777 m 1400 1857 l 1405 1935 l 1407 2010 l 1417 2070 l 1425 2137 l + 1440 2215 l 1455 2297 l 1470 2365 l 1490 2437 l 1510 2495 l + 1527 2547 l 1535 2580 l 1600 2595 l 1672 2605 l 1772 2602 l + 1865 2595 l 1947 2572 l 2005 2555 l 2075 2525 l 2150 2482 l + 2207 2442 l 2260 2400 l 2295 2367 l 2325 2332 l 2325 1775 l + + cp gs 0.75 setgray ef gr +% Polyline +n 2330 1222 m 2365 1265 l 2402 1317 l 2437 1382 l 2477 1455 l 2500 1517 l + 2520 1585 l 2532 1645 l 2540 1712 l 2542 1780 l 2540 1842 l + 2535 1907 l 2527 1957 l 2517 1990 l 2325 1987 l + cp gs 0.75 setgray ef gr +/Times-Roman-iso ff 165.00 scf sf +1331 3044 m +gs 1 -1 sc (XU - X - B) col0 sh gr +/Times-Roman-iso ff 165.00 scf sf +1113 3314 m +gs 1 -1 sc (undefined_functions) col0 sh gr +% Polyline +7.500 slw +n 4816 1982 m + 5008 1982 l gs 0.95 setgray ef gr gs col0 s gr +% Polyline +n 7308 1967 m + 7500 1967 l gs 0.95 setgray ef gr gs col0 s gr +% Polyline +n 2324 1989 m + 2516 1989 l gs 0.95 setgray ef gr gs col0 s gr +/Times-Roman-iso ff 150.00 scf sf +1275 3525 m +gs 1 -1 sc (\(modules mode\)) col0 sh gr +% Arc +n 2652.5 1773.5 960.5 -25.7 25.7 arc +gs col-1 s gr + +% Arc +n 6307.0 1773.0 2416.0 160.6 -160.6 arc +gs col-1 s gr + +% Arc +n 2105.3 1773.0 2432.7 -19.2 19.2 arc +gs col-1 s gr + +% Ellipse +n 4214 1774 820 821 0 360 DrawEllipse gs col-1 s gr + +% Polyline +n 4817 2325 m 4825 2325 l gs col-1 s gr +% Polyline +n 4816 1217 m + 4816 2329 l gs col-1 s gr +% Polyline +n 3392 1769 m + 4816 1769 l gs col-1 s gr +% Arc +n 5144.5 1758.5 960.5 -25.7 25.7 arc +gs col-1 s gr + +% Arc +n 8799.0 1758.0 2416.0 160.6 -160.6 arc +gs col-1 s gr + +% Arc +n 4597.3 1758.0 2432.7 -19.2 19.2 arc +gs col-1 s gr + +% Ellipse +n 6706 1759 820 821 0 360 DrawEllipse gs col-1 s gr + +% Polyline +n 7309 2310 m 7317 2310 l gs col-1 s gr +% Polyline +n 7308 1202 m + 7308 2314 l gs col-1 s gr +% Polyline +n 5884 1754 m + 7308 1754 l gs col-1 s gr +% Arc +n 160.5 1780.5 960.5 -25.7 25.7 arc +gs col-1 s gr + +% Arc +n 3815.0 1780.0 2416.0 160.6 -160.6 arc +gs col-1 s gr + +% Arc +n -386.7 1780.0 2432.7 -19.2 19.2 arc +gs col-1 s gr + +% Ellipse +n 1722 1781 820 821 0 360 DrawEllipse gs col-1 s gr + +% Polyline +n 2325 2332 m 2333 2332 l gs col-1 s gr +% Polyline +n 2324 1224 m + 2324 2336 l gs col-1 s gr +% Polyline +n 900 1776 m + 2324 1776 l gs col-1 s gr +$F2psEnd +rs diff --git a/lib/tools/doc/src/warning.gif b/lib/tools/doc/src/warning.gif new file mode 100644 index 0000000000..96af52360e Binary files /dev/null and b/lib/tools/doc/src/warning.gif differ diff --git a/lib/tools/doc/src/xref.xml b/lib/tools/doc/src/xref.xml new file mode 100644 index 0000000000..6fff68fe9f --- /dev/null +++ b/lib/tools/doc/src/xref.xml @@ -0,0 +1,1554 @@ + + + + +
+ + 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. + + + + xref + Hans Bolinder + nobody + + nobody + no + 2000-08-15 + PA1 + xref.sgml +
+ xref + A Cross Reference Tool for analyzing dependencies between functions, modules, applications and releases. + +

Xref is a cross reference tool that can be used for finding + dependencies between functions, modules, applications and + releases. +

+

Calls between functions are either +local calls like f(), or +external calls like + m:f(). +Module data, + which are extracted from BEAM files, include local functions, + exported functions, local calls and external calls. By default, + calls to built-in functions () are ignored, but + if the option builtins, accepted by some of this + module's functions, is set to true, calls to BIFs + are included as well. It is the analyzing OTP version that + decides what functions are BIFs. Functional objects are assumed + to be called where they are created (and nowhere else). +Unresolved calls are calls to + apply or spawn with variable module, variable + function, or variable arguments. Examples are M:F(a), + apply(M, f, [a]), and + spawn(m, f(), Args). Unresolved calls are + represented by calls where variable modules have been replaced + with the atom '$M_EXPR', variable functions have been + replaced with the atom '$F_EXPR', and variable number of + arguments have been replaced with the number -1. The + above mentioned examples are represented by calls to + '$M_EXPR':'$F_EXPR'/1, '$M_EXPR':f/1, and + m:'$F_EXPR'/-1. The unresolved calls are a subset of the + external calls. +

+ +

Unresolved calls make module data incomplete, which + implies that the results of analyses may be invalid.

+ +

Applications are collections of modules. The + modules' BEAM files are located in the ebin + subdirectory of the application directory. The name of the + application directory determines the name and version of the + application. + Releases are collections of applications + located in the lib subdirectory of the release directory. + There is more to read about applications and releases in the + Design Principles book. +

+

+Xref servers are identified + by names, supplied when creating new servers. Each Xref server + holds a set of releases, a set of applications, and a set of + modules with module data. Xref servers are independent of each + other, and all analyses are evaluated in the context of one + single Xref server (exceptions are the functions m/1 and + d/1 which do not use servers at all). The +mode of an Xref server determines what module + data are extracted from BEAM files as modules are added to the + server. Starting with R7, BEAM files compiled with the option + debug_info contain so called +debug information, which is an abstract + representation of the code. In functions mode, which is + the default mode, function calls and line numbers are extracted + from debug information. In modules mode, debug + information is ignored if present, but dependencies between + modules are extracted from other parts of the BEAM files. The + modules mode is significantly less time and space + consuming than the functions mode, but the analyses that + can be done are limited. +

+

An +analyzed module is a + module that has been added to an Xref server together with its + module data. + A +library module is a + module located in some directory mentioned in the +library path. + A library module is said to be used if some of its exported + functions are used by some analyzed module. + An +unknown module is a + module that is neither an analyzed module nor a library module, + but whose exported functions are used by some analyzed module. + An +unknown function is a + used function that is neither local or exported by any + analyzed module nor exported by any library module. + An +undefined function is an externally used function that + is not exported by any analyzed module or library module. With + this notion, a local function can be an undefined function, namely + if it is externally used from some module. All unknown functions + are also undefined functions; there is a figure in the + User's Guide that illustrates this relationship. +

+

Starting with R9C, the module attribute tag deprecated + can be used to inform Xref about +deprecated functions and + optionally when functions are planned to be removed. A few + examples show the idea: +

+ + -deprecated({f,1}). + The exported function f/1 is deprecated. Nothing is + said whether f/1 will be removed or not. + -deprecated({f,'_'}). + All exported functions f/0, f/1 and so on are + deprecated. + -deprecated(module). + All exported functions in the module are deprecated. + Equivalent to -deprecated({'_','_'}).. + -deprecated([{g,1,next_version}]). + The function g/1 is deprecated and will be + removed in next version. + -deprecated([{g,2,next_major_release}]). + The function g/2 is deprecated and will be + removed in next major release. + -deprecated([{g,3,eventually}]). + The function g/3 is deprecated and will + eventually be removed. + -deprecated({'_','_',eventually}). + All exported functions in the module are deprecated and + will eventually be removed. + +

Before any analysis can take place, module data must be set up. For instance, the cross reference and the unknown + functions are computed when all module data are known. The + functions that need complete data (analyze, q, + variables) take care of setting up data automatically. + Module data need to be set up (again) after calls to any of the + add, replace, remove, + set_library_path or update functions. +

+

The result of setting up module data is the +Call Graph. A (directed) graph + consists of a set of vertices and a set of (directed) edges. The + edges represent +calls (From, To) + between functions, modules, applications or releases. From is + said to call To, and To is said to be used by From. The vertices + of the Call Graph are the functions of all module data: local + and exported functions of analyzed modules; used BIFs; used + exported functions of library modules; and unknown functions. + The functions module_info/0,1 added by the compiler are + included among the exported functions, but only when called from + some module. The edges are the function calls of all module + data. A consequence of the edges being a set is that there is + only one edge if a function is locally or externally used + several times on one and the same line of code. +

+

The Call Graph is +represented by + Erlang terms (the sets are lists), which is suitable for many + analyses. But for analyses that look at chains of calls, a list + representation is much too + slow. Instead the representation offered by the digraph + module is used. The translation of the list representation of + the Call Graph - or a subgraph thereof - to the digraph + representation does not + come for free, so the language used for expressing queries to be + described below has a special operator for this task and a + possibility to save the digraph representation for + subsequent analyses. +

+

In addition to the Call Graph there is a graph called the + +Inter Call Graph. This is + a graph of calls (From, To) such that there is a chain of + calls from From to To in the Call Graph, and every From and To + is an exported function or an unused local function. + The vertices are the same as for the Call Graph. +

+

Calls between modules, applications and releases are also + directed graphs. The +types + of the vertices and edges of these graphs are (ranging from the + most special to the most general): + Fun for functions; Mod for modules; + App for applications; and Rel for releases. + The following paragraphs will describe the different constructs + of the language used for selecting and analyzing parts of the + graphs, beginning with the +constants: +

+ + Expression ::= Constants + Constants ::= Consts | Consts : Type | RegExpr + Consts ::= Constant | [Constant, ...] + | {Constant, ...} + Constant ::= Call | Const + Call ::= FunSpec -> FunSpec + | {MFA, MFA} + | AtomConst -> AtomConst + | {AtomConst, AtomConst} + Const ::= AtomConst | FunSpec | MFA + AtomConst ::= Application | Module | Release + FunSpec ::= Module : Function / Arity + MFA ::= + {Module, Function, Arity} + RegExpr ::= RegString : Type + | RegFunc + | RegFunc : Type + RegFunc ::= RegModule : RegFunction / RegArity + RegModule ::= RegAtom + RegFunction ::= RegAtom + RegArity ::= RegString | Number | _ | -1 + RegAtom ::= RegString | Atom | _ + RegString ::= - a regular expression, as described in the + regexp module, enclosed in double quotes - + Type ::= Fun | Mod | App | Rel + Function ::= Atom + Application ::= Atom + Module ::= Atom + Release ::= Atom + Arity ::= Number | -1 + Atom ::= - same as Erlang atoms - + Number ::= - same as non-negative Erlang integers - + +

Examples of constants are: kernel, kernel->stdlib, + [kernel, sasl], [pg -> mnesia, {tv, mnesia}] : Mod. + It is an error if an instance of Const does not match any + vertex of any graph. + If there are more than one vertex matching an untyped instance + of AtomConst, then the one of the most general type is + chosen. + A list of constants is interpreted as a set of constants, all of + the same type. + A tuple of constants constitute a chain of calls (which may, + but does not have to, correspond to an actual chain of calls of + some graph). + Assigning a type to a list or tuple of Constant is + equivalent to assigning the type to each Constant. +

+

+Regular expressions are used as a + means to select some of the vertices of a graph. + A RegExpr consisting of a RegString and a type - + an example is "xref_.*" : Mod - is interpreted as those + modules (or applications or releases, depending on the type) + that match the expression. + Similarly, a RegFunc is interpreted as those vertices + of the Call Graph that match the expression. + An example is "xref_.*":"add_.*"/"(2|3)", which matches + all add functions of arity two or three of any of the + xref modules. + Another example, one that matches all functions of arity 10 or + more: _:_/"[1-9].+". Here _ is an abbreviation for + ".*", that is, the regular expression that matches + anything. +

+

The syntax of +variables is + simple: +

+ + Expression ::= Variable + Variable ::= - same as Erlang variables - + +

There are two kinds of variables: predefined variables and user + variables. + +Predefined variables + hold set up module data, and cannot be assigned to but only used + in queries. + +User variables on the other + hand can be assigned to, and are typically used for + temporary results while evaluating a query, and for keeping + results of queries for use in subsequent queries. + The predefined variables are (variables marked with (*) are + available in functions mode only): +

+ + E + Call Graph Edges (*). + V + Call Graph Vertices (*). + + M + Modules. All modules: analyzed modules, used library + modules, and unknown modules. + A + Applications. + R + Releases. + + ME + Module Edges. All module calls. + AE + Application Edges. All application calls. + RE + Release Edges. All release calls. + + L + Local Functions (*). All local functions of analyzed modules. + X + Exported Functions. All exported functions of analyzed + modules and all used exported functions of library modules. + F + Functions (*). + B + Used BIFs. B is empty if builtins is + false for all analyzed modules. + U + Unknown Functions. + UU + Unused Functions (*). All local and exported functions of + analyzed modules that have not been used. + XU + Externally Used Functions. Functions of all modules - + including local functions - that have been used in some + external call. + LU + Locally Used Functions (*). Functions of all modules that have + been used in some local call. + + LC + Local Calls (*). + XC + External Calls (*). + + AM + Analyzed Modules. + UM + Unknown Modules. + LM + Used Library Modules. + + UC + Unresolved Calls. Empty in modules mode. + + EE + Inter Call Graph Edges (*). + + DF + Deprecated Functions. All deprecated exported + functions and all used deprecated BIFs. + DF_1 + Deprecated Functions. All deprecated functions + to be removed in next version. + DF_2 + Deprecated Functions. All deprecated functions + to be removed in next version or next major release. + DF_3 + Deprecated Functions. All deprecated functions to be + removed in next version, next major release, or later. + +

These are a few +facts about the + predefined variables (the set operators + (union) and + - (difference) as well as the cast operator + (Type) are described below): +

+ + F is equal to L + X. + V is equal to X + L + B + U, where X, + L, B and U are pairwise disjoint (that + is, have no elements in common). + UU is equal to V - (XU + LU), where + LU and XU may have elements in common. Put in + another way: + V is equal to UU + XU + LU. + E is equal to LC + XC. Note that LC + and XC may have elements in common, namely if some + function is locally and externally used from one and the same + function. + U is a subset of XU. + B is a subset of XU. + LU is equal to range LC. + XU is equal to range XC. + LU is a subset of F. + UU is a subset of F. + range UC is a subset of U. + M is equal to AM + LM + UM, where AM, + LM and UM are pairwise disjoint. + ME is equal to (Mod) E. + AE is equal to (App) E. + RE is equal to (Rel) E. + (Mod) V is a subset of M. Equality holds + if all analyzed modules have some local, exported, or unknown + function. + (App) M is a subset of A. Equality holds + if all applications have some module. + (Rel) A is a subset of R. Equality holds + if all releases have some application. + DF_1 is a subset of DF_2. + DF_2 is a subset of DF_3. + DF_3 is a subset of DF. + DF is a subset of X + B. + +

An important notion is that of +conversion of expressions. The syntax of + a cast expression is: +

+ + Expression ::= ( Type ) Expression + +

The interpretation of the cast operator depends on the named + type Type, the type of Expression, and the + structure of the elements of the interpretation of Expression. + If the named type is equal to the + expression type, no conversion is done. Otherwise, the + conversion is done one step at a time; + (Fun) (App) RE, for instance, is equivalent to + (Fun) (Mod) (App) RE. Now assume that the + interpretation of Expression is a set of constants + (functions, modules, applications or releases). If the named + type is more general than the expression type, say Mod + and Fun respectively, then the interpretation of the cast + expression is the set of modules that have at least one + of their functions mentioned in the interpretation of the + expression. If the named + type is more special than the expression type, say Fun + and Mod, then the interpretation is the set of all the + functions of the modules (in modules mode, the conversion + is partial since the local functions are not known). + The conversions to and from applications and releases + work analogously. For instance, (App) "xref_.*" : Mod + returns all applications containing at least one module + such that xref_ is a prefix of the module name. +

+

Now assume that the interpretation of Expression is a + set of calls. If the named type is more general than the + expression type, say Mod and Fun respectively, + then the interpretation of the cast expression is the set of + calls (M1, M2) such that the interpretation of the + expression contains a call from some function + of M1 to some function of M2. If the named type is more special + than the expression type, say Fun and Mod, then + the interpretation is the set of all function calls + (F1, F2) such that the interpretation of the expression + contains a call (M1, M2) and F1 is + a function of M1 and F2 is a function of M2 (in modules + mode, there are no functions calls, so a cast to Fun + always yields an empty set). Again, the conversions to and from + applications and releases work analogously. +

+

The interpretation of constants and variables are sets, and + those sets can be used as the basis for forming new sets by the + application of +set operators. + The syntax: +

+ + Expression ::= Expression BinarySetOp Expression + BinarySetOp ::= + | * | - + +

+, * and - are interpreted as union, + intersection and difference respectively: the union of two sets + contains the elements of both sets; the intersection of two sets + contains the elements common to both sets; and the difference of + two sets contains the elements of the first set that are not + members of the second set. The elements of the two sets must be + of the same structure; for instance, a function call cannot be + combined with a function. But if a cast operator can make the + elements compatible, then the more general elements are + converted to the less general element type. For instance, + M + F is equivalent to + (Fun) M + F, and E - AE + is equivalent to E - (Fun) AE. One more + example: X * xref : Mod is interpreted as the set of + functions exported by the module xref; xref : Mod + is converted to the more special type of X (Fun, + that is) yielding all functions of xref, and the + intersection with X (all functions exported by analyzed + modules and library modules) is interpreted as those functions + that are exported by some module and functions of + xref. +

+

There are also unary set operators: +

+ + Expression ::= UnarySetOp Expression + UnarySetOp ::= domain | range | strict + +

Recall that a call is a pair (From, To). domain + applied to a set of calls is interpreted as the set of all + vertices From, and range as the set of all vertices To. + The interpretation of the strict operator is the operand + with all calls on the form (A, A) removed. +

+

The interpretation of the +restriction operators is a + subset of the first operand, a set of calls. The second operand, + a set of vertices, is converted to the type of the first operand. + The syntax of the restriction operators: +

+ + Expression ::= Expression RestrOp Expression + RestrOp ::= | + RestrOp ::= || + RestrOp ::= ||| + +

The interpretation in some detail for the three operators: +

+ + | + The subset of calls from any of the vertices. + || + The subset of calls to any of the vertices. + ||| + The subset of calls to and from any of the vertices. + For all sets of calls CS and all sets of vertices + VS, CS ||| VS  is equivalent to + CS | VS * CS || VS. + +

+Two functions (modules, + applications, releases) belong to the same strongly connected + component if they call each other (in)directly. The + interpretation of the components operator is the set of + strongly connected components of a set of calls. The + condensation of a set of calls is a new set of calls + between the strongly connected components such that there is an + edge between two components if there is some constant of the first + component that calls some constant of the second component. +

+

The interpretation of the of operator is a chain of + calls of the second operand (a set of calls) that passes throw + all of the vertices of the first operand (a tuple of + constants), in the given order. The second operand + is converted to the type of the first operand. + For instance, the of operator can be used for finding out + whether a function calls another function indirectly, and the + chain of calls demonstrates how. The syntax of the graph + analyzing operators: +

+ + Expression ::= Expression GraphOp Expression + GraphOp ::= components | condensation | of + +

As was mentioned before, the graph analyses operate on + the digraph representation of graphs. + By default, the digraph representation is created when + needed (and deleted when no longer used), but it can also be + created explicitly by use of the closure operator: +

+ + Expression ::= ClosureOp Expression + ClosureOp ::= closure + +

The interpretation of the closure operator is the + transitive closure of the operand. +

+

The restriction operators are defined for closures as well; + closure E | xref : Mod is + interpreted as the direct or indirect function calls from the + xref module, while the interpretation of + E | xref : Mod is the set of direct + calls from xref. + If some graph is to be used in several graph analyses, it saves + time to assign the digraph representation of the graph + to a user variable, + and then make sure that every graph analysis operates on that + variable instead of the list representation of the graph. +

+

The lines where functions are defined (more precisely: where + the first clause begins) and the lines where functions are used + are available in functions mode. The line numbers refer + to the files where the functions are defined. This holds also for + files included with the -include and -include_lib + directives, which may result in functions defined apparently in + the same line. The line operators are used for assigning + line numbers to functions and for assigning sets of line numbers + to function calls. + The syntax is similar to the one of the cast operator: +

+ + Expression ::= ( LineOp) Expression + Expression ::= ( XLineOp) Expression + LineOp ::= Lin | ELin | LLin | XLin + XLineOp ::= XXL + +

The interpretation of the Lin operator applied to a set + of functions assigns to each function the line number where the + function is defined. Unknown functions and functions of library + modules are assigned the number 0. +

+

The interpretation of some LineOp operator applied to a + set of function calls assigns to each call the set of line + numbers where the first function calls the second function. Not + all calls are assigned line numbers by all operators: +

+ + the Lin operator is defined for Call Graph Edges; + the LLin operator is defined for Local Calls. + the XLin operator is defined for External Calls. + the ELin operator is defined for Inter Call Graph Edges. + +

The Lin (LLin, XLin) operator assigns + the lines where calls (local calls, external calls) are made. + The ELin operator assigns to each call (From, To), + for which it is defined, every line L such that there is + a chain of calls from From to To beginning with a call on line + L. +

+

The XXL operator is defined for the interpretation of + any of the LineOp operators applied to a set of function + calls. The result is that of replacing the function call with + a line numbered function call, that is, each of the two + functions of the call is replaced by a pair of the function and + the line where the function is defined. The effect of the + XXL operator can be undone by the LineOp operators. For + instance, (Lin) (XXL) (Lin) E is + equivalent to (Lin) E. +

+

The +, -, * and # operators are + defined for line number expressions, provided the operands are + compatible. The LineOp operators are also defined for + modules, applications, and releases; the operand is implicitly + converted to functions. Similarly, the cast operator is defined + for the interpretation of the LineOp operators. +

+

The interpretation of the +counting operator is the number of elements of a set. The operator + is undefined for closures. The +, - and * + operators are interpreted as the obvious arithmetical operators + when applied to numbers. The syntax of the counting operator: +

+ + Expression ::= CountOp Expression + CountOp ::= # + +

All binary operators are left associative; for instance, + A | B  || C is equivalent to + (A | B) || C. The following is a list + of all operators, in increasing order of +precedence: +

+ + +, - + * + # + |, ||, ||| + of + (Type) + closure, components, condensation, + domain, range, strict + +

Parentheses are used for grouping, either to make an expression + more readable or to override the default precedence of operators: +

+ + Expression ::= ( Expression ) + +

A +query is a non-empty sequence of + statements. A statement is either an assignment of a user + variable or an expression. The value of an assignment is the + value of the right hand side expression. It makes no sense to + put a plain expression anywhere else but last in queries. The + syntax of queries is summarized by these productions: +

+ + Query ::= Statement, ... + Statement ::= Assignment | Expression + Assignment ::= Variable := Expression + | Variable = Expression + +

A variable cannot be assigned a new value unless first removed. + Variables assigned to by the = operator are removed at + the end of the query, while variables assigned to by the + := operator can only be removed by calls to + forget. There are no user variables when module data + need to be set up again; if any of the functions that make it + necessary to set up module data again is called, all user + variables are forgotten. +

+

Types

+ 
+application() = atom()
+arity() = int() | -1
+bool() = true | false
+call() = {atom(), atom()} | funcall()
+constant() = mfa() | module() | application() | release()
+directory() = string()
+file() = string()
+funcall() = {mfa(), mfa()}
+function() = atom()
+int() = integer() >= 0
+library() = atom()
+library_path() = path() | code_path
+mfa() = {module(), function(), arity()}
+mode() = functions | modules
+module() = atom()
+release() = atom()
+string_position() = int() | at_end
+variable() = atom()
+xref() = atom() | pid()
+ + + + add_application(Xref, Directory [, Options]) -> {ok, application()} | Error + Add the modules of an application. + + Directory = directory() + Error = {error, module(), Reason} + Options = [Option] | Option + Option = {builtins, bool()} | {name, application()} | {verbose, bool()} | {warnings, bool()} + Reason = {application_clash, {application(), directory(), directory()}} | {file_error, file(), error()} | {invalid_filename, term()} | {invalid_options, term()} | - see also add_directory - + Xref = xref() + + +

Adds an application, the modules of the application and module data of the + modules to an Xref server. + The modules will be members of the application. + The default is to use the base name of the + directory with the version removed as application name, but + this can be overridden by the name option. Returns the + name of the application. +

+

If the given directory has a subdirectory named + ebin, modules (BEAM files) are searched for in that + directory, otherwise modules are searched for in the given + directory. +

+

If the mode of the Xref + server is functions, BEAM files that contain no + debug information are + ignored. +

+ + + + add_directory(Xref, Directory [, Options]) -> {ok, Modules} | Error + Add the modules in a directory. + + Directory = directory() + Error = {error, module(), Reason} + Modules = [module()] + Options = [Option] | Option + Option = {builtins, bool()} | {recurse, bool()} | {verbose, bool()} | {warnings, bool()} + Reason = {file_error, file(), error()} | {invalid_filename, term()} | {invalid_options, term()} | {unrecognized_file, file()} | - error from beam_lib:chunks/2 - + Xref = xref() + + +

Adds the modules found in the given directory and the modules' data + to an Xref server. + The default is not to examine subdirectories, but if the option + recurse has the value true, modules are searched + for in subdirectories on all levels as well as in the given + directory. + Returns a sorted list of the names of the added modules. +

+

The modules added will not be members of any applications. +

+

If the mode of the Xref + server is functions, BEAM files that contain no + debug information are + ignored. +

+ + + + add_module(Xref, File [, Options]) -> {ok, module()} | Error + Add a module. + + Error = {error, module(), Reason} + File = file() + Options = [Option] | Option + Option = {builtins, bool()} | {verbose, bool()} | {warnings, bool()} + Reason = {file_error, file(), error()} | {invalid_filename, term()} | {invalid_options, term()} | {module_clash, {module(), file(), file()}} | {no_debug_info, file()} | - error from beam_lib:chunks/2 - + Xref = xref() + + +

Adds a module and its module data to an Xref server. + The module will not be member of any application. + Returns the name of the module. +

+

If the mode of the Xref + server is functions, and the BEAM file contains no + debug information, + the error message no_debug_info is returned. +

+ + + + add_release(Xref, Directory [, Options]) -> {ok, release()} | Error + Add the modules of a release. + + Directory = directory() + Error = {error, module(), Reason} + Options = [Option] | Option + Option = {builtins, bool()} | {name, release()} | {verbose, bool()} | {warnings, bool()} + Reason = {application_clash, {application(), directory(), directory()}} | {file_error, file(), error()} | {invalid_filename, term()} | {invalid_options, term()} | {release_clash, {release(), directory(), directory()}} | - see also add_directory - + Xref = xref() + + +

Adds a release, the applications of the release, the + modules of the applications, and module data of the + modules to an Xref server. + The applications will be members of the release, + and the modules will be members of the applications. + The default is to use the base name of the + directory as release name, but this can be overridden by the + name option. Returns the name of the release. +

+

If the given directory has a subdirectory named lib, + the directories in that directory are assumed to be + application directories, otherwise all subdirectories of the + given directory are assumed to be application directories. + If there are several versions of some application, the one + with the highest version is chosen. +

+

If the mode of the Xref + server is functions, BEAM files that contain no + debug information are + ignored. +

+ + + + analyze(Xref, Analysis [, Options]) -> {ok, Answer} | Error + Evaluate a predefined analysis. + + Analysis = undefined_function_calls | undefined_functions | locals_not_used | exports_not_used | deprecated_function_calls | {deprecated_function_calls, DeprFlag} | deprecated_functions | {deprecated_functions, DeprFlag} | {call, FuncSpec} | {use, FuncSpec} | {module_call, ModSpec} | {module_use, ModSpec} | {application_call, AppSpec} | {application_use, AppSpec} | {release_call, RelSpec} | {release_use, RelSpec} + Answer = [term()] + AppSpec = application() | [application()] + DeprFlag = next_version | next_major_release | eventually + Error = {error, module(), Reason} + FuncSpec = mfa() | [mfa()] + ModSpec = module() | [module()] + Options = [Option] | Option + Option = {verbose, bool()} + RelSpec = release() | [release()] + Reason = {invalid_options, term()} | {parse_error, string_position(), term()} | {unavailable_analysis, term()} | {unknown_analysis, term()} | {unknown_constant, string()} | {unknown_variable, variable()} + Xref = xref() + + +

+Evaluates a predefined analysis. + Returns a sorted list without duplicates of call() or + constant(), depending on the chosen analysis. The + predefined analyses, which operate on all analyzed modules, are + (analyses marked with (*) are available in functionsmode only):

+ + undefined_function_calls(*) + Returns a list of calls to undefined functions. + undefined_functions + Returns a list of undefined functions. + locals_not_used(*) + Returns a list of local functions that have not been + locally used. + exports_not_used + Returns a list of exported functions that have not been + externally used. + deprecated_function_calls(*) + Returns a list of external calls to deprecated functions. + {deprecated_function_calls, DeprFlag}(*) + Returns a list of external calls to deprecated + functions. If DeprFlag is equal to + next_version, calls to functions to be removed in + next version are returned. If DeprFlag is equal to + next_major_release, calls to functions to be + removed in next major release are returned as well as + calls to functions to be removed in next version. Finally, + if DeprFlag is equal to eventually, all + calls to functions to be removed are returned, including + calls to functions to be removed in next version or next + major release. + deprecated_functions + Returns a list of externally used deprecated + functions. + {deprecated_functions, DeprFlag} + Returns a list of externally used deprecated + functions. If DeprFlag is equal to + next_version, functions to be removed in next + version are returned. If DeprFlag is equal to + next_major_release, functions to be removed in next + major release are returned as well as functions to be + removed in next version. Finally, if DeprFlag is + equal to eventually, all functions to be removed + are returned, including functions to be removed in next + version or next major release. + {call, FuncSpec}(*) + Returns a list of functions called by some of the given + functions. + {use, FuncSpec}(*) + Returns a list of functions that use some of the given + functions. + {module_call, ModSpec} + Returns a list of modules called by some of the given + modules. + {module_use, ModSpec} + Returns a list of modules that use some of the given + modules. + {application_call, AppSpec} + Returns a list of applications called by some of the given + applications. + {application_use, AppSpec} + Returns a list of applications that use some of the given + applications. + {release_call, RelSpec} + Returns a list of releases called by some of the given + releases. + {release_use, RelSpec} + Returns a list of releases that use some of the given + releases. + + + + + d(Directory) -> [DebugInfoResult] | [NoDebugInfoResult] | Error + Check the modules in a directory using the code path. + + Directory = directory() + DebugInfoResult = {deprecated, [funcall()]} | {undefined, [funcall()]} | {unused, [mfa()]} + Error = {error, module(), Reason} + NoDebugInfoResult = {deprecated, [mfa()]} | {undefined, [mfa()]} + Reason = {file_error, file(), error()} | {invalid_filename, term()} | {unrecognized_file, file()} | - error from beam_lib:chunks/2 - + + +

The modules found in the given directory are checked for + calls to deprecated functions, calls to undefined functions, + and for unused local functions. The code path is used as + library path. +

+

If some of the found BEAM files contain debug information, then those + modules are checked and a list of tuples is returned. The + first element of each tuple is one of: +

+ + deprecated, the second element is a sorted list + of calls to deprecated functions; + undefined, the second element is a sorted list + of calls to undefined functions; + unused, the second element is a sorted list of + unused local functions. + +

If no BEAM file contains debug information, then a list of + tuples is returned. The first element of each tuple is one + of: +

+ + deprecated, the second element is a sorted list + of externally used deprecated functions; + undefined, the second element is a sorted list + of undefined functions. + + + + + forget(Xref) -> ok + forget(Xref, Variables) -> ok | Error + Remove user variables and their values. + + Error = {error, module(), Reason} + Reason = {not_user_variable, term()} + Variables = [variable()] | variable() + Xref = xref() + + +

forget/1 and forget/2 remove all or some of + the user variables of an xref server.

+ + + + format_error(Error) -> Chars + Return an English description of an Xref error reply. + + Error = {error, module(), term()} + Chars = [char() | Chars] + + +

Given the error returned by any function of this module, + the function format_error returns a descriptive string + of the error in English. For file errors, the function + format_error/1 in the file module is called.

+ + + + get_default(Xref) -> [{Option, Value}] + get_default(Xref, Option) -> {ok, Value} | Error + Return the default values of options. + + Error = {error, module(), Reason} + Option = builtins | recurse | verbose | warnings + Reason = {invalid_options, term()} + Value = bool() + Xref = xref() + + +

Returns the default values of one or more options.

+ + + + get_library_path(Xref) -> {ok, LibraryPath} + Return the library path. + + LibraryPath = library_path() + Xref = xref() + + +

Returns the library path.

+ + + + info(Xref) -> [Info] + info(Xref, Category) -> [{Item, [Info]}] + info(Xref, Category, Items) -> [{Item, [Info]}] + Return information about an Xref server. + + Application = [] | [application()] + Category = modules | applications | releases | libraries + Info = {application, Application} | {builtins, bool()} | {directory, directory()} | {library_path, library_path()} | {mode, mode()} | {no_analyzed_modules, int()} | {no_applications, int()} | {no_calls, {NoResolved, NoUnresolved}} | {no_function_calls, {NoLocal, NoResolvedExternal, NoUnresolved}} | {no_functions, {NoLocal, NoExternal}} | {no_inter_function_calls, int()} | {no_releases, int()} | {release, Release} | {version, Version} + Item = module() | application() | release() | library() + Items = Item | [Item] + NoLocal = NoExternal = NoResolvedExternal, NoResolved = NoUnresolved = int() + Release = [] | [release()] + Version = [int()] + Xref = xref() + + +

The info functions return information as a list of + pairs {Tag, term()} in some order about the state and the + module data of an Xref server. +

+

info/1 returns information with the following tags + (tags marked with (*) are available in functions + mode only):

+ + library_path, the library path; + mode, the mode; + no_releases, number of releases; + no_applications, total number of applications + (of all releases); + no_analyzed_modules, total number of analyzed modules; + no_calls (*), total number of calls (in all + modules), regarding instances of one function call in + different lines as separate calls; + no_function_calls (*), total number of local calls, resolved external calls and + unresolved calls; + no_functions (*), total number of local and exported + functions; + no_inter_function_calls (*), total number of + calls of the Inter Call Graph. + +

info/2 and info/3 return information about + all or some of the analyzed modules, applications, releases + or library modules of an Xref server. + The following information is returned for every analyzed module:

+ + application, an empty list if the module does + not belong to any application, otherwise a list of + the application name; + builtins, whether calls to BIFs are included + in the module's data; + directory, the directory where the + module's BEAM file is located; + no_calls (*), number of calls, regarding + instances of one function call in different lines as + separate calls; + no_function_calls (*), number of local + calls, resolved external calls and unresolved calls; + no_functions (*), number of local and exported + functions; + no_inter_function_calls (*), number of calls + of the Inter Call Graph; + +

The following information is returned for every application:

+ + directory, the directory where the + modules' BEAM files are located; + no_analyzed_modules, number of analyzed + modules; + no_calls (*), number of calls of the + application's modules, regarding instances of + one function call in different lines as separate calls; + no_function_calls (*), number of local + calls, resolved external calls and unresolved calls of the + application's modules; + no_functions (*), number of local and exported + functions of the application's modules; + no_inter_function_calls (*), number of calls + of the Inter Call Graph of the + application's modules; + release, an empty list if the application does not + belong to any release, otherwise a list of the release name; + version, the application's version as + a list of numbers. For instance, the directory "kernel-2.6" + results in the application name kernel and the + application version [2,6]; "kernel" yields the name + kernel and the version []. + +

The following information is returned for every release:

+ + directory, the release directory; + no_analyzed_modules, number of analyzed + modules; + no_applications, number of applications; + no_calls (*), number of calls of the + release's modules, regarding + instances of one function call in different lines as + separate calls; + no_function_calls (*), number of local + calls, resolved external calls and unresolved + calls of the release's modules; + no_functions (*), number of local and exported + functions of the release's modules; + no_inter_function_calls (*), number of calls + of the Inter Call Graph of the release's modules. + +

The following information is returned for every library module:

+ + directory, the directory where the library module's BEAM file is located. + +

For every number of calls, functions etc. returned by the + no_ tags, there is a query returning the same number. + Listed below are examples of such queries. Some of the + queries return the sum of a two or more of the no_ + tags numbers. mod (app, rel) refers to + any module (application, release). +

+ + +

no_analyzed_modules

+ + "# AM" (info/1) + "# (Mod) app:App" + (application) + "# (Mod) rel:Rel" (release) + + + +

no_applications

+ + "# A" (info/1) + + + +

no_calls. The sum of the number of resolved and + unresolved calls:

+ + "# (XLin) E + # (LLin) E" (info/1) + "T = E | mod:Mod, # (LLin) T + # (XLin) T" + (module) + "T = E | app:App, # (LLin) T + # (XLin) T" + (application) + "T = E | rel:Rel, # (LLin) T + # (XLin) T" + (release) + + + +

no_functions. Functions in library modules and + the functions module_info/0,1 are not counted by + info. Assuming that "Extra := _:module_info/\\"(0|1)\\" + LM" has been evaluated, the + sum of the number of local and exported functions are:

+ + "# (F - Extra)" (info/1) + "# (F * mod:Mod - Extra)" (module) + "# (F * app:App - Extra)" (application) + "# (F * rel:Rel - Extra)" (release) + + + +

no_function_calls. The sum of the number of + local calls, resolved external calls and unresolved calls:

+ + "# LC + # XC" (info/1) + "# LC | mod:Mod + # XC | mod:Mod" (module) + "# LC | app:App + # XC | app:App" (application) + "# LC | rel:Rel + # XC | mod:Rel" (release) + + + +

no_inter_function_calls

+ + "# EE" (info/1) + "# EE | mod:Mod" (module) + "# EE | app:App" (application) + "# EE | rel:Rel" (release) + + + +

no_releases

+ + "# R" (info/1) + + + + + + + m(Module) -> [DebugInfoResult] | [NoDebugInfoResult] | Error + m(File) -> [DebugInfoResult] | [NoDebugInfoResult] | Error + Check a module using the code path. + + DebugInfoResult = {deprecated, [funcall()]} | {undefined, [funcall()]} | {unused, [mfa()]} + Error = {error, module(), Reason} + File = file() + Module = module() + NoDebugInfoResult = {deprecated, [mfa()]} | {undefined, [mfa()]} + Reason = {file_error, file(), error()} | {interpreted, module()} | {invalid_filename, term()} | {cover_compiled, module()} | {no_such_module, module()} | - error from beam_lib:chunks/2 - + + +

The given BEAM file (with or without the .beam + extension) or the file found by calling + code:which(Module) is checked for calls to deprecated functions, calls to undefined functions, + and for unused local functions. The code path is used as + library path. +

+

If the BEAM file contains debug information, then a + list of tuples is returned. The first element of each tuple + is one of: +

+ + deprecated, the second element is a sorted list + of calls to deprecated functions; + undefined, the second element is a sorted list + of calls to undefined functions; + unused, the second element is a sorted list of + unused local functions. + +

If the BEAM file does not contain debug information, then a + list of tuples is returned. The first element of each tuple + is one of: +

+ + deprecated, the second element is a sorted list + of externally used deprecated functions; + undefined, the second element is a sorted list + of undefined functions. + + + + + q(Xref, Query [, Options]) -> {ok, Answer} | Error + Evaluate a query. + + Answer = false | [constant()] | [Call] | [Component] | int() | [DefineAt] | [CallAt] | [AllLines] + Call = call() | ComponentCall + ComponentCall = {Component, Component} + Component = [constant()] + DefineAt = {mfa(), LineNumber} + CallAt = {funcall(), LineNumbers} + AllLines = {{DefineAt, DefineAt}, LineNumbers} + Error = {error, module(), Reason} + LineNumbers = [LineNumber] + LineNumber = int() + Options = [Option] | Option + Option = {verbose, bool()} + Query = string() | atom() + Reason = {invalid_options, term()} | {parse_error, string_position(), term()} | {type_error, string()} | {type_mismatch, string(), string()} | {unknown_analysis, term()} | {unknown_constant, string()} | {unknown_variable, variable()} | {variable_reassigned, string()} + Xref = xref() + + +

Evaluates a query in the + context of an Xref server, and returns the value of the last + statement. The syntax of the value depends on the + expression: +

+ + A set of calls is represented by a sorted list without + duplicates of call(). + A set of constants is represented by a sorted list + without duplicates of constant(). + A set of strongly connected components is a sorted list + without duplicates of Component. + A set of calls between strongly connected components is + a sorted list without duplicates of ComponentCall. + A chain of calls is represented by a list of + constant(). The list contains the From vertex of every + call and the To vertex of the last call. + The of operator returns false if no chain + of calls between the given constants can be found. + The value of the closure operator (the + digraph representation) is represented by the atom + 'closure()'. + A set of line numbered functions is represented by a sorted + list without duplicates of DefineAt. + A set of line numbered function calls is represented by + a sorted list without duplicates of CallAt. + A set of line numbered functions and function calls is + represented by a sorted list without duplicates of + AllLines. + +

For both CallAt and AllLines it holds that for + no list element is LineNumbers an empty list; such + elements have been removed. The constants of component + and the integers of LineNumbers are sorted and without + duplicates. +

+ + + + remove_application(Xref, Applications) -> ok | Error + Remove applications and their modules. + + Applications = application() | [application()] + Error = {error, module(), Reason} + Reason = {no_such_application, application()} + Xref = xref() + + +

Removes applications and their modules and module data from an Xref server.

+ + + + remove_module(Xref, Modules) -> ok | Error + Remove analyzed modules. + + Error = {error, module(), Reason} + Modules = module() | [module()] + Reason = {no_such_module, module()} + Xref = xref() + + +

Removes analyzed modules and module data from an Xref server.

+ + + + remove_release(Xref, Releases) -> ok | Error + Remove releases and their applications and modules. + + Error = {error, module(), Reason} + Reason = {no_such_release, release()} + Releases = release() | [release()] + Xref = xref() + + +

Removes releases and their applications, modules and + module data from an + Xref server.

+ + + + replace_application(Xref, Application, Directory [, Options]) -> {ok, application()} | Error + Replace an application's modules. + + Application = application() + Directory = directory() + Error = {error, module(), Reason} + Options = [Option] | Option + Option = {builtins, bool()} | {verbose, bool()} | {warnings, bool()} + Reason = {no_such_application, application()} | - see also add_application - + Xref = xref() + + +

Replaces the modules of an application with other modules + read from an application directory. Release membership of the + application is retained. Note that the name of the + application is kept; the name of the given directory is not + used. +

+ + + + replace_module(Xref, Module, File [, Options]) -> {ok, module()} | Error + Replace an analyzed module. + + Error = {error, module(), Reason} + File = file() + Module = module() + Options = [Option] | Option + Option = {verbose, bool()} | {warnings, bool()} + ReadModule = module() + Reason = {module_mismatch, module(), ReadModule} | {no_such_module, module()} | - see also add_module - + Xref = xref() + + +

Replaces module data of an analyzed module with + data read from a BEAM file. Application membership of the + module is retained, and so is the value of the + builtins option of the module. An error is returned + if the name of the read module differs from the given + module. +

+

The update function is an alternative for updating + module data of recompiled modules.

+ + + + set_default(Xref, Option, Value) -> {ok, OldValue} | Error + set_default(Xref, OptionValues) -> ok | Error + Set the default values of options. + + Error = {error, module(), Reason} + OptionValues = [OptionValue] | OptionValue + OptionValue = {Option, Value} + Option = builtins | recurse | verbose | warnings + Reason = {invalid_options, term()} + Value = bool() + Xref = xref() + + +

Sets the default value of one or more options. + The options that can be set this way are:

+ + builtins, with initial default value false; + recurse, with initial default value false; + verbose, with initial default value false; + warnings, with initial default value true. + +

The initial default values are set when creating an Xref server. +

+ + + + set_library_path(Xref, LibraryPath [, Options]) -> ok | Error + Set the library path and finds the library modules. + + Error = {error, module(), Reason} + LibraryPath = library_path() + Options = [Option] | Option + Option = {verbose, bool()} + Reason = {invalid_options, term()} | {invalid_path, term()} + Xref = xref() + + +

Sets the library path. If the given path is a list of + directories, the set of library modules is + determined by choosing the first module + encountered while traversing the directories in + the given order, for those modules that occur in more than + one directory. By default, the library path is an empty list. +

+

The library path +code_path is + used by the functions + m/1 and d/1, but can also be set explicitly. + Note however that the code path will be traversed once for + each used library module while setting up module data. + On the other hand, if there are only a few modules that are + used by not analyzed, using code_path may be faster + than setting the library path to code:get_path(). +

+

If the library path is set to code_path, the set of + library modules is not determined, and the info + functions will return empty lists of library modules.

+ + + + start(NameOrOptions) -> Return + Create an Xref server. + + Name = atom()() + XrefOrOptions = Xref | Options + Options = [Option] | Option + Option = {xref_mode, mode()} | term() + Return = {ok, pid()} | {error, {already_started, pid()}} + + +

Creates an Xref server. + The process may optionally be given a name. + The default mode is functions. + Options that are not recognized by Xref + are passed on to gen_server:start/4.

+ + + + start(Name, Options) -> Return + Create an Xref server. + + Name = atom()() + Options = [Option] | Option + Option = {xref_mode, mode()} | term() + Return = {ok, pid()} | {error, {already_started, pid()}} + + +

Creates an Xref server + with a given name. + The default mode is functions. + Options that are not recognized by Xref + are passed on to gen_server:start/4.

+ + + + stop(Xref) + Delete an Xref server. + + Xref = xref() + + +

Stops an Xref server.

+ + + + update(Xref [, Options]) -> {ok, Modules} | Error + Replace newly compiled analyzed modules. + + Error = {error, module(), Reason} + Modules = [module()] + Options = [Option] | Option + Option = {verbose, bool()} | {warnings, bool()} + Reason = {invalid_options, term()} | {module_mismatch, module(), ReadModule} | - see also add_module - + Xref = xref() + + +

Replaces the module data of all analyzed modules the BEAM + files of which have been modified since last read by an + add function or update. Application membership + of the modules is retained, and so is the value of the + builtins option. Returns a sorted list + of the names of the replaced modules.

+ + + + variables(Xref [, Options]) -> {ok, [VariableInfo]} + Return the names of variables. + + Options = [Option] | Option + Option = predefined | user | {verbose, bool()} + Reason = {invalid_options, term()} + VariableInfo = {predefined, [variable()]} | {user, [variable()]} + Xref = xref() + + +

Returns a sorted lists of the names of the variables of an + Xref server. + The default is to return the user variables only.

+ + + + +
+ See Also +

beam_lib(3), digraph(3), digraph_utils(3), regexp(3), + TOOLS User's Guide

+
+ + diff --git a/lib/tools/doc/src/xref_chapter.xml b/lib/tools/doc/src/xref_chapter.xml new file mode 100644 index 0000000000..39c5545af9 --- /dev/null +++ b/lib/tools/doc/src/xref_chapter.xml @@ -0,0 +1,383 @@ + + + + +
+ + 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. + + + + Xref - The Cross Reference Tool + Hans Bolinder + nobody + + nobody + no + 2000-08-18 + PA1 + xref_chapter.xml +
+

Xref is a cross reference tool that can be used for + finding dependencies between functions, modules, applications + and releases. It does so by analyzing the defined functions + and the function calls. +

+

In order to make Xref easy to use, there are predefined + analyses that perform some common tasks. Typically, a module + or a release can be checked for calls to undefined functions. + For the somewhat more advanced user there is a small, but + rather flexible, language that can be used for selecting parts + of the analyzed system and for doing some simple graph + analyses on selected calls. +

+

The following sections show some features of Xref, beginning + with a module check and a predefined analysis. Then follow + examples that can be skipped on the first reading; not all of + the concepts used are explained, and it is assumed that the + reference manual has been at + least skimmed. +

+ +
+ Module Check +

Assume we want to check the following module: +

+ 
+    -module(my_module).
+
+    -export([t/1]).
+
+    t(A) ->
+      my_module:t2(A).
+
+    t2(_) ->
+      true.
+

Cross reference data are read from BEAM files, so the first + step when checking an edited module is to compile it: +

+ 
+    1> c(my_module, debug_info).
+    ./my_module.erl:10: Warning: function t2/1 is unused
+    {ok, my_module}
+

The debug_info option ensures that the BEAM file + contains debug information, which makes it possible to find + unused local functions. +

+

The module can now be checked for calls to deprecated functions, calls to undefined functions, + and for unused local functions: +

+ 
+    2> xref:m(my_module)
+    [{deprecated,[]},
+     {undefined,[{{my_module,t,1},{my_module,t2,1}}]},
+     {unused,[{my_module,t2,1}]}]
+

m/1 is also suitable for checking that the + BEAM file of a module that is about to be loaded into a + running a system does not call any undefined functions. In + either case, the code path of the code server (see the module + code) is used for finding modules that export externally + called functions not exported by the checked module itself, so + called library modules. +

+
+ +
+ Predefined Analysis +

In the last example the module to analyze was given as an + argument to m/1, and the code path was (implicitly) + used as library path. In this example an xref server will be used, + which makes it possible to analyze applications and releases, + and also to select the library path explicitly. +

+

Each Xref server is referred to by a unique name. The name + is given when creating the server: +

+ 
+    1> xref:start(s).
+    {ok,<0.27.0>}
+

Next the system to be analyzed is added to the Xref server. + Here the system will be OTP, so no library path will be needed. + Otherwise, when analyzing a system that uses OTP, the OTP + modules are typically made library modules by + setting the library path to the default OTP code path (or to + code_path, see the reference manual). By + default, the names of read BEAM files and warnings are output + when adding analyzed modules, but these messages can be avoided + by setting default values of some options: +

+ 
+    2> xref:set_default(s, [{verbose,false}, {warnings,false}]).
+    ok
+    3> xref:add_release(s, code:lib_dir(), {name, otp}).
+    {ok,otp}
+

add_release/3 assumes that all subdirectories of the + library directory returned by code:lib_dir() contain + applications; the effect is that of reading all + applications' BEAM files. +

+

It is now easy to check the release for calls to undefined + functions: +

+ 
+    4> xref:analyze(s, undefined_function_calls).
+    {ok, [...]}
+

We can now continue with further analyses, or we can delete + the Xref server: +

+ 
+    5> xref:stop(s).
+

The check for calls to undefined functions is an example of a + predefined analysis, probably the most useful one. Other + examples are the analyses that find unused local + functions, or functions that call some given functions. See + the analyze/2,3 + functions for a complete list of predefined analyses. +

+

Each predefined analysis is a shorthand for a query, a sentence of a tiny + language providing cross reference data as + values of predefined variables. + The check for calls to undefined functions can thus be stated as + a query: +

+ 
+    4> xref:q(s, "(XC - UC) || (XU - X - B)").
+    {ok,[...]}
+

The query asks for the restriction of external calls except the + unresolved calls to calls to functions that are externally used + but neither exported nor built-in functions (the || + operator restricts the used functions while the | + operator restricts the calling functions). The - operator + returns the difference of two sets, and the + operator to + be used below returns the union of two sets. +

+

The relationships between the predefined variables + XU, X, B and a few + others are worth elaborating upon. + The reference manual mentions two ways of expressing the set of + all functions, one that focuses on how they are defined: + X + L + B + U, and one + that focuses on how they are used: + UU + LU + XU. + The reference also mentions some facts about the + variables: +

+ + F is equal to L + X (the defined functions + are the local functions and the external functions); + U is a subset of XU (the unknown functions + are a subset of the externally used functions since + the compiler ensures that locally used functions are defined); + B is a subset of XU (calls to built-in + functions are always external by definition, and unused + built-in functions are ignored); + LU is a subset of F (the locally used + functions are either local functions or exported functions, + again ensured by the compiler); + UU is equal to + F - (XU + LU) (the unused functions + are defined functions that are neither used externally nor + locally); + UU is a subset of F (the unused functions + are defined in analyzed modules). + +

Using these facts, the two small circles in the picture below + can be combined. +

+ + Definition and use of functions + +

It is often clarifying to mark the variables of a query in such + a circle. This is illustrated in the picture below for some of + the predefined analyses. Note that local functions used by local + functions only are not marked in the locals_not_used + circle. +

+ + Some predefined analyses as subsets of all functions + +
+ +
+ Expressions +

The module check and the predefined analyses are useful, but + limited. Sometimes more flexibility is needed, for instance one + might not need to apply a graph analysis on all calls, but some + subset will do equally well. That flexibility is provided with + a simple language. Below are some expressions of the language + with comments, focusing on elements of the language rather than + providing useful examples. The analyzed system is assumed to be + OTP, so in order to run the queries, first evaluate these calls: +

+ 
+    xref:start(s).
+    xref:add_release(s, code:root_dir()).
+ + xref:q(s, "(Fun) xref : Mod"). + All functions of the xref module. + xref:q(s, "xref : Mod * X"). + All exported functions of the xref module. The first + operand of the intersection operator * is implicitly + converted to the more special type of the second operand. + xref:q(s, "(Mod) tools"). + All modules of the tools application. + xref:q(s, '"xref_.*" : Mod'). + All modules with a name beginning with xref_. + xref:q(s, "# E | X "). + Number of calls from exported functions. + xref:q(s, "XC || L "). + All external calls to local functions. + xref:q(s, "XC * LC"). + All calls that have both an external and a local version. + xref:q(s, "(LLin) (LC * XC)"). + The lines where the local calls of the last example + are made. + xref:q(s, "(XLin) (LC * XC)"). + The lines where the external calls of the example before + last are made. + xref:q(s, "XC * (ME - strict ME)"). + External calls within some module. + xref:q(s, "E ||| kernel"). + All calls within the kernel application. + xref:q(s, "closure E | kernel || kernel"). + All direct and indirect calls within the kernel + application. Both the calling and the used functions of + indirect calls are defined in modules of the kernel + application, but it is possible that some functions outside + the kernel application are used by indirect calls. + xref:q(s, "{toolbar,debugger}:Mod of ME"). + A chain of module calls from toolbar to + debugger, if there is such a chain, otherwise + false. The chain of calls is represented by a list of + modules, toolbar being the first element and + debuggerthe last element. + xref:q(s, "closure E | toolbar:Mod || debugger:Mod"). + All (in)direct calls from functions in toolbar to + functions in debugger. + xref:q(s, "(Fun) xref -> xref_base"). + All function calls from xref to xref_base. + xref:q(s, "E * xref -> xref_base"). + Same interpretation as last expression. + xref:q(s, "E || xref_base | xref"). + Same interpretation as last expression. + xref:q(s, "E * [xref -> lists, xref_base -> digraph]"). + All function calls from xref to lists, and + all function calls from xref_base to digraph. + xref:q(s, "E | [xref, xref_base] || [lists, digraph]"). + All function calls from xref and xref_base + to lists and digraph. + xref:q(s, "components EE"). + All strongly connected components of the Inter Call + Graph. Each component is a set of exported or unused local functions + that call each other (in)directly. + xref:q(s, "X * digraph * range (closure (E | digraph) | (L * digraph))"). + All exported functions of the digraph module + used (in)directly by some function in digraph. + xref:q(s, "L * yeccparser:Mod - range (closure (E | + + yeccparser:Mod) | (X * yeccparser:Mod))"). + The interpretation is left as an exercise. + +
+ +
+ Graph Analysis +

The list representation of graphs is used analyzing direct calls, + while the digraph representation is suited for analyzing + indirect calls. The restriction operators (|, || + and |||) are the only operators that accept both + representations. This means that in order to analyze indirect + calls using restriction, the closure operator (which creates the + digraph representation of graphs) has to been + applied explicitly. +

+

As an example of analyzing indirect calls, the following Erlang + function tries to answer the question: + if we want to know which modules are used indirectly by some + module(s), is it worth while using the function graph rather + than the module graph? Recall that a module M1 is said to call + a module M2 if there is some function in M1 that calls some + function in M2. It would be nice if we could use the much + smaller module graph, since it is available also in the light + weight modulesmode of Xref servers. +

+ + t(S) -> + {ok, _} = xref:q(S, "Eplus := closure E"), + {ok, Ms} = xref:q(S, "AM"), + Fun = fun(M, N) -> + Q = io_lib:format("# (Mod) (Eplus | ~p : Mod)", [M]), + {ok, N0} = xref:q(S, lists:flatten(Q)), + N + N0 + end, + Sum = lists:foldl(Fun, 0, Ms), + ok = xref:forget(S, 'Eplus'), + {ok, Tot} = xref:q(S, "# (closure ME | AM)"), + 100 * ((Tot - Sum) / Tot). +

Comments on the code: +

+ + We want to find the reduction of the closure of the + function graph to modules. + The direct expression for doing that would be + (Mod) (closure E | AM), but then we + would have to represent all of the transitive closure of E in + memory. Instead the number of indirectly used modules is + found for each analyzed module, and the sum over all modules + is calculated. + + A user variable is employed for holding the digraph + representation of the function graph for use in many + queries. The reason is efficiency. As opposed to the + = operator, the := operator saves a value for + subsequent analyses. Here might be the place to note that + equal subexpressions within a query are evaluated only once; + = cannot be used for speeding things up. + + Eplus | ~p : Mod. The | operator converts + the second operand to the type of the first operand. In this + case the module is converted to all functions of the + module. It is necessary to assign a type to the module + (: Mod), otherwise modules like kernel would be + converted to all functions of the application with the same + name; the most general constant is used in cases of ambiguity. + + Since we are only interested in a ratio, the unary + operator # that counts the elements of the operand is + used. It cannot be applied to the digraph representation + of graphs. + + We could find the size of the closure of the module graph + with a loop similar to one used for the function graph, but + since the module graph is so much smaller, a more direct + method is feasible. + + +

When the Erlang function t/1 was applied to an Xref + server loaded with the current version of OTP, the returned + value was close to 84 (percent). This means that the number + of indirectly used modules is approximately six times greater + when using the module graph. + So the answer to the above stated question is that it is + definitely worth while using the function graph for this + particular analysis. + Finally, note that in the presence of unresolved calls, the + graphs may be incomplete, which means that there may be + indirectly used modules that do not show up. +

+
+ + diff --git a/lib/tools/ebin/.gitignore b/lib/tools/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/tools/emacs/AUTHORS b/lib/tools/emacs/AUTHORS new file mode 100644 index 0000000000..b5f426ba81 --- /dev/null +++ b/lib/tools/emacs/AUTHORS @@ -0,0 +1,15 @@ +Original Authors: +The Erlang emacs mode was written by Anders Lindgren. + +Contributors: +Luke Gorrie +Dave Love + +Maintainers: +Sverker Wiberg +Kent Boortz +Björn Gustavsson + +Currently maintained by: +Ingela Anderton Andin +Dan Gudmundsson \ No newline at end of file diff --git a/lib/tools/emacs/Makefile b/lib/tools/emacs/Makefile new file mode 100644 index 0000000000..7249263992 --- /dev/null +++ b/lib/tools/emacs/Makefile @@ -0,0 +1,84 @@ +# ``The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance 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_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(TOOLS_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(VSN) + +# ---------------------------------------------------- +# Common Macros +# ---------------------------------------------------- + +MAN_FILES= \ + tags.3 + +EMACS_FILES= \ + erlang-start \ + erlang-eunit \ + erlang + +README_FILES= README + +EL_FILES = $(EMACS_FILES:%=%.el) + +ELC_FILES = $(EMACS_FILES:%=%.elc) + +TEST_FILES = test.erl.indented test.erl.orig + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) $(EL_FILES) + +clean: + rm -f $(TARGET_FILES) $(ELC_FILES) + rm -f errs core *~ + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/emacs + $(INSTALL_DATA) $(EL_FILES) $(README_FILES) $(TEST_FILES) \ + $(RELSYSDIR)/emacs + +ifeq ($(DOCTYPE),pdf) +release_docs_spec: +else +ifeq ($(DOCTYPE),ps) +release_docs_spec: +else +release_docs_spec: docs + $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 + $(INSTALL_DATA) $(MAN_FILES) $(RELEASE_PATH)/man/man3 +endif +endif diff --git a/lib/tools/emacs/README b/lib/tools/emacs/README new file mode 100644 index 0000000000..ca068d04c4 --- /dev/null +++ b/lib/tools/emacs/README @@ -0,0 +1,48 @@ +User configuration notes +======================== + +Below is a quick guide to necessary configurations for getting +started with the Erlang mode for Emacs. Please refer to the +Users guide and reference manual in the documentation for the +Erlang/OTP application tools for more information. + + +For UNIX users +-------------- + +To set up the Erlang Emacs mode on UNIX systems, edit/create the file +.emacs in the your home directory. + +Below is a complete example of what should be added to a user's .emacs +provided that OTP is installed in the directory /usr/local/otp: + + (setq load-path (cons "/usr/local/otp/lib/tools-/emacs" + load-path)) + (setq erlang-root-dir "/usr/local/otp") + (setq exec-path (cons "/usr/local/otp/bin" exec-path)) + (require 'erlang-start) + + +For Windows users +----------------- + +To set up the Erlang Emacs mode on Windows systems, edit/create the +file .emacs, the location of the file depends on the configuration of +the system. If the HOME environment variable is set, Emacs will look +for the .emacs file in the directory indicated by the HOME +variable. If HOME is not set, Emacs will look for the .emacs file in +C:\. + +Below is a complete example of what should be added to a user's .emacs +provided that OTP is installed in the directory C:\Program +Files\erl-: + + (setq load-path (cons "C:/Program Files/erl/lib/tools-/emacs" + load-path)) + (setq erlang-root-dir "C:/Program Files/erl") + (setq exec-path (cons "C:/Program Files/erl/bin" exec-path)) + (require 'erlang-start) + + + + diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el new file mode 100644 index 0000000000..05528aee6d --- /dev/null +++ b/lib/tools/emacs/erlang-eunit.el @@ -0,0 +1,254 @@ +;; +;; %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% +;;; +;;; Purpose: Provide EUnit utilities. +;;; +;;; Author: Klas Johansson + +(defvar erlang-eunit-separate-src-and-test-directories t + "*Whether or not to keep source and EUnit test files in separate directories") + +;;; +;;; Switch between src/EUnit test buffers +;;; +(defun erlang-eunit-toggle-src-and-test-file-other-window () + "Switch to the src file if the EUnit test file is the current +buffer and vice versa" + (interactive) + (if (erlang-eunit-test-file-p buffer-file-name) + (erlang-eunit-open-src-file-other-window buffer-file-name) + (erlang-eunit-open-test-file-other-window buffer-file-name))) + +;;; +;;; Open the EUnit test file which corresponds to a src file +;;; +(defun erlang-eunit-open-test-file-other-window (src-file-path) + "Open the EUnit test file which corresponds to a src file" + (find-file-other-window (erlang-eunit-test-filename src-file-path))) + + +;;; +;;; Open the src file which corresponds to the an EUnit test file +;;; +(defun erlang-eunit-open-src-file-other-window (test-file-path) + "Open the src file which corresponds to the an EUnit test file" + (find-file-other-window (erlang-eunit-src-filename test-file-path))) + +;;; Return the name and path of the EUnit test file +;;, (input may be either the source filename itself or the EUnit test filename) +(defun erlang-eunit-test-filename (file-path) + (erlang-eunit-rewrite-filename file-path "test" "_tests")) + +;;; Return the name and path of the source file +;;, (input may be either the source filename itself or the EUnit test filename) +(defun erlang-eunit-src-filename (file-path) + (erlang-eunit-rewrite-filename file-path "src" "")) + +;;; Rewrite a filename from the src or test filename to the other +(defun erlang-eunit-rewrite-filename (orig-file-path dest-dirname dest-suffix) + (let* ((root-dir-name (erlang-eunit-file-root-dir-name orig-file-path)) + (src-module-name (erlang-eunit-source-module-name orig-file-path)) + (dest-base-name (concat src-module-name dest-suffix ".erl")) + (dest-dir-name-1 (file-name-directory orig-file-path)) + (dest-dir-name-2 (filename-join root-dir-name dest-dirname)) + (dest-file-name-1 (filename-join dest-dir-name-1 dest-base-name)) + (dest-file-name-2 (filename-join dest-dir-name-2 dest-base-name))) + ;; This function tries to be a bit intelligent: + ;; * if there already is a test (or source) file in the same + ;; directory as a source (or test) file, it'll be picked + ;; * if there already is a test (or source) file in a separate + ;; test (or src) directory, it'll be picked + ;; * otherwise it'll resort to whatever alternative (same or + ;; separate directories) that the user has chosen + (cond ((file-readable-p dest-file-name-1) + dest-file-name-1) + ((file-readable-p dest-file-name-2) + dest-file-name-2) + (erlang-eunit-separate-src-and-test-directories + dest-file-name-2) + (t + dest-file-name-1)))) + +;;; Checks whether a file is a EUnit test file or not +(defun erlang-eunit-test-file-p (file-path) + (erlang-eunit-string-match-p "^\\(.+\\)_tests.erl$" file-path)) + +;;; Return the module name of the source file +;;; /tmp/foo/src/x.erl --> x +;;; /tmp/foo/test/x_tests.erl --> x +(defun erlang-eunit-source-module-name (file-path) + (interactive) + (let* ((file-name (file-name-nondirectory file-path)) + (base-name (file-name-sans-extension file-name))) + (if (string-match "^\\(.+\\)_tests$" base-name) + (substring base-name (match-beginning 1) (match-end 1)) + base-name))) + +;;; Return the directory name which is common to both src and test +;;; /tmp/foo/src/x.erl --> /tmp/foo +;;; /tmp/foo/test/x_tests.erl --> /tmp/foo +(defun erlang-eunit-file-root-dir-name (file-path) + (erlang-eunit-dir-parent-dirname (file-name-directory file-path))) + +;;; Return the parent directory name of a directory +;;; /tmp/foo/ --> /tmp +;;; /tmp/foo --> /tmp +(defun erlang-eunit-dir-parent-dirname (dir-name) + (file-name-directory (directory-file-name dir-name))) + +;;; Older emacsen don't have string-match-p. +(defun erlang-eunit-string-match-p (regexp string &optional start) + (if (fboundp 'string-match-p) ;; appeared in emacs 23 + (string-match-p regexp string start) + (save-match-data ;; fallback for earlier versions of emacs + (string-match regexp string start)))) + +;;; Join filenames +(defun filename-join (dir file) + (if (or (= (elt file 0) ?/) + (= (car (last (append dir nil))) ?/)) + (concat dir file) + (concat dir "/" file))) + +;;; Run EUnit tests for the current module +(defun erlang-eunit-run-tests () + "Run the EUnit test suite for the current module. + +With prefix arg, runs tests with the verbose flag set." + (interactive) + (let* ((module-name (erlang-add-quotes-if-needed + (erlang-eunit-source-module-name buffer-file-name))) + (opts (if current-prefix-arg ", [verbose]" "")) + (command (format "eunit:test(%s%s)." module-name opts))) + (erlang-eunit-inferior-erlang-send-command command))) + +;;; Compile source and EUnit test file and finally run EUnit tests for +;;; the current module +(defun erlang-eunit-compile-and-run-tests () + "Compile the source and test files and run the EUnit test suite. + +With prefix arg, compiles for debug and runs tests with the verbose flag set." + (interactive) + (let ((src-filename (erlang-eunit-src-filename buffer-file-name)) + (test-filename (erlang-eunit-test-filename buffer-file-name))) + + ;; The purpose of out-maneuvering `save-some-buffers', as is done + ;; below, is to ask the question about saving buffers only once, + ;; instead of possibly several: one for each file to compile, + ;; for instance for both x.erl and x_tests.erl. + (save-some-buffers) + (flet ((save-some-buffers (&optional any) nil)) + + ;; Compilation of the source file is mandatory (the file must + ;; exist, otherwise the procedure is aborted). Compilation of the + ;; test file on the other hand, is optional, since eunit tests may + ;; be placed in the source file instead. Any compilation error + ;; will prevent the subsequent steps to be run (hence the `and') + (and (erlang-eunit-compile-file src-filename) + (if (file-readable-p test-filename) + (erlang-eunit-compile-file test-filename) + t) + (erlang-eunit-run-tests))))) + +(defun erlang-eunit-compile-file (file-path) + (if (file-readable-p file-path) + (save-excursion + (set-buffer (find-file-noselect file-path)) + (erlang-compile) + (erlang-eunit-last-compilation-successful-p)) + (let ((msg (format "Could not read %s" file-path))) + (erlang-eunit-inferior-erlang-send-command + (format "%% WARNING: %s" msg)) + (error msg)))) + +(defun erlang-eunit-last-compilation-successful-p () + (save-excursion + (set-buffer inferior-erlang-buffer) + (goto-char compilation-parsing-end) + (erlang-eunit-all-list-elems-fulfill-p + (lambda (re) (let ((continue t) + (result t)) + (while continue ; ignore warnings, stop at errors + (if (re-search-forward re (point-max) t) + (if (erlang-eunit-is-compilation-warning) + t + (setq result nil) + (setq continue nil)) + (setq result t) + (setq continue nil))) + result)) + (mapcar (lambda (e) (car e)) erlang-error-regexp-alist)))) + +(defun erlang-eunit-is-compilation-warning () + (erlang-eunit-string-match-p + "[0-9]+: Warning:" + (buffer-substring (line-beginning-position) (line-end-position)))) + +(defun erlang-eunit-all-list-elems-fulfill-p (pred list) + (let ((matches-p t)) + (while (and list matches-p) + (if (not (funcall pred (car list))) + (setq matches-p nil)) + (setq list (cdr list))) + matches-p)) + +;;; Evaluate a command in an erlang buffer +(defun erlang-eunit-inferior-erlang-send-command (command) + "Evaluate a command in an erlang buffer." + (interactive "P") + (inferior-erlang-prepare-for-input) + (inferior-erlang-send-command command) + (sit-for 0) ;; redisplay + (inferior-erlang-wait-prompt)) + + +;;;==================================================================== +;;; Key bindings +;;;==================================================================== + +(defvar erlang-eunit-toggle-src-and-test-file-other-window-key "\C-c\C-et" + "*Key to which the `erlang-eunit-toggle-src-and-test-file-other-window' +function will be bound.") +(defvar erlang-eunit-compile-and-run-tests-key "\C-c\C-ek" + "*Key to which the `erlang-eunit-compile-and-run-tests' +function will be bound.") + +(defun erlang-eunit-add-key-bindings () + (erlang-eunit-ensure-keymap-for-key + erlang-eunit-toggle-src-and-test-file-other-window-key) + (local-set-key erlang-eunit-toggle-src-and-test-file-other-window-key + 'erlang-eunit-toggle-src-and-test-file-other-window) + (erlang-eunit-ensure-keymap-for-key + erlang-eunit-compile-and-run-tests-key) + (local-set-key erlang-eunit-compile-and-run-tests-key + 'erlang-eunit-compile-and-run-tests)) + +(defun erlang-eunit-ensure-keymap-for-key (key-seq) + (let ((prefix-keys (butlast (append key-seq nil))) + (prefix-seq "")) + (while prefix-keys + (setq prefix-seq (concat prefix-seq (make-string 1 (car prefix-keys)))) + (setq prefix-keys (cdr prefix-keys)) + (if (not (keymapp (lookup-key (current-local-map) prefix-seq))) + (local-set-key prefix-seq (make-sparse-keymap)))))) + +(add-hook 'erlang-mode-hook 'erlang-eunit-add-key-bindings) + + +(provide 'erlang-eunit) +;; erlang-eunit ends here diff --git a/lib/tools/emacs/erlang-start.el b/lib/tools/emacs/erlang-start.el new file mode 100644 index 0000000000..542e81f24c --- /dev/null +++ b/lib/tools/emacs/erlang-start.el @@ -0,0 +1,116 @@ +;; erlang-start.el --- Load this file to initialize the Erlang package. + +;; Copyright (C) 1998 Ericsson Telecom AB + +;; Author: Anders Lindgren +;; Version: 2.3 +;; Keywords: erlang, languages, processes +;; Created: 1996-09-18 +;; Date: 1998-03-16 + +;;; Commentary: + +;; Introduction: +;; ------------ +;; +;; This package provides support for the programming language Erlang. +;; The package provides an editing mode with lots of bells and +;; whistles, compilation support, and it makes it possible for the +;; user to start Erlang shells that run inside Emacs. +;; +;; See the Erlang distribution for full documentation of this package. + +;; Installation: +;; ------------ +;; +;; Place this file in Emacs load path, byte-compile it, and add the +;; following line to the appropriate init file: +;; +;; (require 'erlang-start) +;; +;; The full documentation contains much more extensive description of +;; the installation procedure. + +;; Reporting Bugs: +;; -------------- +;; +;; Please send bug reports to the following email address: +;; support@erlang.ericsson.se +;; +;; Please state as exactly as possible: +;; - Version number of Erlang Mode (see the menu), Emacs, Erlang, +;; and of any other relevant software. +;; - What the expected result was. +;; - What you did, preferably in a repeatable step-by-step form. +;; - A description of the unexpected result. +;; - Relevant pieces of Erlang code causing the problem. +;; - Personal Emacs customisations, if any. +;; +;; Should the Emacs generate an error, please set the emacs variable +;; `debug-on-error' to `t'. Repeat the error and enclose the debug +;; information in your bug-report. +;; +;; To set the variable you can use the following command: +;; M-x set-variable RET debug-on-error RET t RET + +;;; Code: + +;; +;; Declare functions in "erlang.el". +;; + +(autoload 'erlang-mode "erlang" "Major mode for editing Erlang code." t) +(autoload 'erlang-version "erlang" + "Return the current version of Erlang mode." t) +(autoload 'erlang-shell "erlang" "Start a new Erlang shell." t) +(autoload 'run-erlang "erlang" "Start a new Erlang shell." t) + +(autoload 'erlang-compile "erlang" + "Compile Erlang module in current buffer." t) + +(autoload 'erlang-man-module "erlang" + "Find manual page for MODULE." t) +(autoload 'erlang-man-function "erlang" + "Find manual page for NAME, where NAME is module:function." t) + +(autoload 'erlang-find-tag "erlang" + "Like `find-tag'. Capable of retreiving Erlang modules.") +(autoload 'erlang-find-tag-other-window "erlang" + "Like `find-tag-other-window'. Capable of retreiving Erlang modules.") + + +;; +;; Associate files extensions ".erl" and ".hrl" with Erlang mode. +;; + +(let ((a '("\\.erl\\'" . erlang-mode)) + (b '("\\.hrl\\'" . erlang-mode))) + (or (assoc (car a) auto-mode-alist) + (setq auto-mode-alist (cons a auto-mode-alist))) + (or (assoc (car b) auto-mode-alist) + (setq auto-mode-alist (cons b auto-mode-alist)))) + + +;; +;; Ignore files ending in ".jam", ".vee", and ".beam" when performing +;; file completion. +;; + +(let ((erl-ext '(".jam" ".vee" ".beam"))) + (while erl-ext + (let ((cie completion-ignored-extensions)) + (while (and cie (not (string-equal (car cie) (car erl-ext)))) + (setq cie (cdr cie))) + (if (null cie) + (setq completion-ignored-extensions + (cons (car erl-ext) completion-ignored-extensions)))) + (setq erl-ext (cdr erl-ext)))) + + +;; +;; The end. +;; + +(provide 'erlang-start) + +;; erlang-start.el ends here. diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el new file mode 100644 index 0000000000..f623e3a1ee --- /dev/null +++ b/lib/tools/emacs/erlang.el @@ -0,0 +1,6651 @@ +;; erlang.el --- Major modes for editing and running Erlang +;; %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% +;; +;; Copyright (C) 2004 Free Software Foundation, Inc. +;; Author: Anders Lindgren +;; Keywords: erlang, languages, processes + +;; Lars Thorsén's modifications of 2000-06-07 included. +;; The original version of this package was written by Robert Virding. +;; +;;; Commentary: + +;; Introduction: +;; ------------ +;; +;; This package provides support for the programming language Erlang. +;; The package provides an editing mode with lots of bells and +;; whistles, compilation support, and it makes it possible for the +;; user to start Erlang shells that run inside Emacs. +;; +;; See the Erlang distribution for full documentation of this package. + +;; Installation: +;; ------------ +;; +;; Place this file in Emacs load path, byte-compile it, and add the +;; following line to the appropriate init file: +;; +;; (require 'erlang-start) +;; +;; The full documentation contains much more extensive description of +;; the installation procedure. + +;; Reporting Bugs: +;; -------------- +;; +;; Please send bug reports to the following email address: +;; erlang-bugs@erlang.org +;; or if you have a patch suggestion to: +;; erlang-patches@erlang.org +;; Please state as exactly as possible: +;; - Version number of Erlang Mode (see the menu), Emacs, Erlang, +;; and of any other relevant software. +;; - What the expected result was. +;; - What you did, preferably in a repeatable step-by-step form. +;; - A description of the unexpected result. +;; - Relevant pieces of Erlang code causing the problem. +;; - Personal Emacs customisations, if any. +;; +;; Should the Emacs generate an error, please set the Emacs variable +;; `debug-on-error' to `t'. Repeat the error and enclose the debug +;; information in your bug-report. +;; +;; To set the variable you can use the following command: +;; M-x set-variable RET debug-on-error RET t RET +;;; Code: + +;; Variables: + +(defconst erlang-version "2.6.1" + "The version number of Erlang mode.") + +(defvar erlang-root-dir nil + "The directory where the Erlang system is installed. +The name should not contain the trailing slash. + +Should this variable be nil, no manual pages will show up in the +Erlang mode menu.") + +(eval-and-compile + (defconst erlang-emacs-major-version + (if (boundp 'emacs-major-version) + emacs-major-version + (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) + (erlang-string-to-int (substring emacs-version + (match-beginning 1) (match-end 1)))) + "Major version number of Emacs.")) + +(eval-and-compile + (defconst erlang-emacs-minor-version + (if (boundp 'emacs-minor-version) + emacs-minor-version + (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) + (erlang-string-to-int (substring emacs-version + (match-beginning 2) (match-end 2)))) + "Minor version number of Emacs.")) + +(defconst erlang-xemacs-p (string-match "Lucid\\|XEmacs" emacs-version) + "Non-nil when running under XEmacs or Lucid Emacs.") + +(defvar erlang-xemacs-popup-menu '("Erlang Mode Commands" . nil) + "Common popup menu for all buffers in Erlang mode. + +This variable is destructively modified every time the Erlang menu +is modified. The effect is that all changes take effect in all +buffers in Erlang mode, just like under GNU Emacs. + +Never EVER set this variable!") + +(defvar erlang-menu-items '(erlang-menu-base-items + erlang-menu-skel-items + erlang-menu-shell-items + erlang-menu-compile-items + erlang-menu-man-items + erlang-menu-personal-items + erlang-menu-version-items) + "*List of menu item list to combine to create Erlang mode menu. + +External programs which temporarily add menu items to the Erlang mode +menu may use this variable. Please use the function `add-hook' to add +items. + +Please call the function `erlang-menu-init' after every change to this +variable.") + +(defvar erlang-menu-base-items + '(("Indent" + (("Indent Line" erlang-indent-command) + ("Indent Region " erlang-indent-region + (if erlang-xemacs-p (mark) mark-active)) + ("Indent Clause" erlang-indent-clause) + ("Indent Function" erlang-indent-function) + ("Indent Buffer" erlang-indent-current-buffer))) + ("Edit" + (("Fill Comment" erlang-fill-paragraph) + ("Comment Region" comment-region + (if erlang-xemacs-p (mark) mark-active)) + ("Uncomment Region" erlang-uncomment-region + (if erlang-xemacs-p (mark) mark-active)) + nil + ("Beginning of Function" erlang-beginning-of-function) + ("End of Function" erlang-end-of-function) + ("Mark Function" erlang-mark-function) + nil + ("Beginning of Clause" erlang-beginning-of-clause) + ("End of Clause" erlang-end-of-clause) + ("Mark Clause" erlang-mark-clause) + nil + ("New Clause" erlang-generate-new-clause) + ("Clone Arguments" erlang-clone-arguments) + nil + ("Align Arrows" erlang-align-arrows))) + ("Syntax Highlighting" + (("Level 4" erlang-font-lock-level-4) + ("Level 3" erlang-font-lock-level-3) + ("Level 2" erlang-font-lock-level-2) + ("Level 1" erlang-font-lock-level-1) + ("Off" erlang-font-lock-level-0))) + ("TAGS" + (("Find Tag" find-tag) + ("Find Next Tag" erlang-find-next-tag) + ;("Find Regexp" find-tag-regexp) + ("Complete Word" erlang-complete-tag) + ("Tags Apropos" tags-apropos) + ("Search Files" tags-search)))) + "Description of menu used in Erlang mode. + +This variable must be a list. The elements are either nil representing +a horizontal line or a list with two or three elements. The first is +the name of the menu item, the second is the function to call, or a +submenu, on the same same form as ITEMS. The third optional argument +is an expression which is evaluated every time the menu is displayed. +Should the expression evaluate to nil the menu item is ghosted. + +Example: + '((\"Func1\" function-one) + (\"SubItem\" + ((\"Yellow\" function-yellow) + (\"Blue\" function-blue))) + nil + (\"Region Function\" spook-function midnight-variable)) + +Call the function `erlang-menu-init' after modifying this variable.") + +(defvar erlang-menu-shell-items + '(nil + ("Shell" + (("Start New Shell" erlang-shell) + ("Display Shell" erlang-shell-display)))) + "Description of the Shell menu used by Erlang mode. + +Please see the documentation of `erlang-menu-base-items'.") + +(defvar erlang-menu-compile-items + '(("Compile" + (("Compile Buffer" erlang-compile) + ("Display Result" erlang-compile-display) + ("Next Error" erlang-next-error)))) + "Description of the Compile menu used by Erlang mode. + +Please see the documentation of `erlang-menu-base-items'.") + +(defvar erlang-menu-version-items + '(nil + ("Version" erlang-version)) + "Description of the version menu used in Erlang mode.") + +(defvar erlang-menu-personal-items nil + "Description of personal menu items used in Erlang mode. + +Please see the variable `erlang-menu-base-items' for a description +of the format.") + +(defvar erlang-menu-man-items nil + "The menu containing man pages. + +The format of the menu should be compatible with `erlang-menu-base-items'. +This variable is added to the list of Erlang menus stored in +`erlang-menu-items'.") + +(defvar erlang-menu-skel-items '() + "Description of the menu containing the skeleton entries. +The menu is in the form described by the variable `erlang-menu-base-items'.") + +(defvar erlang-mode-hook nil + "*Functions to run when Erlang mode is activated. + +This hook is used to change the behaviour of Erlang mode. It is +normally used by the user to personalise the programming environment. +When used in a site init file, it could be used to customise Erlang +mode for all users on the system. + +The functions added to this hook are run every time Erlang mode is +started. See also `erlang-load-hook', a hook which is run once, +when Erlang mode is loaded into Emacs, and `erlang-shell-mode-hook' +which is run every time a new inferior Erlang shell is started. + +To use a hook, create an Emacs lisp function to perform your actions +and add the function to the hook by calling `add-hook'. + +The following example binds the key sequence C-c C-c to the command +`erlang-compile' (normally bound to C-c C-k). The example also +activates Font Lock mode to fontify the buffer and adds a menu +containing all functions defined in the current buffer. + +To use the example, copy the following lines to your `~/.emacs' file: + + (add-hook 'erlang-mode-hook 'my-erlang-mode-hook) + + (defun my-erlang-mode-hook () + (local-set-key \"\\C-c\\C-c\" 'erlang-compile) + (if window-system + (progn + (setq font-lock-maximum-decoration t) + (font-lock-mode 1))) + (if (and window-system (fboundp 'imenu-add-to-menubar)) + (imenu-add-to-menubar \"Imenu\")))") + +(defvar erlang-load-hook nil + "*Functions to run when Erlang mode is loaded. + +This hook is used to change the behaviour of Erlang mode. It is +normally used by the user to personalise the programming environment. +When used in a site init file, it could be used to customize Erlang +mode for all users on the system. + +The difference between this hook and `erlang-mode-hook' and +`erlang-shell-mode-hook' is that the functions in this hook +is only called once, when the Erlang mode is loaded into Emacs +the first time. + +Natural actions for the functions added to this hook are actions which +only should be performed once, and actions which should be performed +before starting Erlang mode. For example, a number of variables are +used by Erlang mode before `erlang-mode-hook' is run. + +The following example sets the variable `erlang-root-dir' so that the +manual pages can be retrieved (note that you must set the value of +`erlang-root-dir' to match the location of Erlang on your system): + + (add-hook 'erlang-load-hook 'my-erlang-load-hook) + + (defun my-erlang-load-hook () + (setq erlang-root-dir \"/usr/local/erlang\"))") + +(defvar erlang-new-file-hook nil + "Functions to run when a new Erlang source file is being edited. + +A useful function is `tempo-template-erlang-normal-header'. +\(This function only exists when the `tempo' package is available.)") + +(defvar erlang-check-module-name 'ask + "*Non-nil means check that module name and file name agrees when saving. + +If the value of this variable is the atom `ask', the user is +prompted. If the value is t the source is silently changed.") + +(defvar erlang-electric-commands + '(erlang-electric-comma + erlang-electric-semicolon + erlang-electric-gt) + "*List of activated electric commands. + +The list should contain the electric commands which should be active. +Currently, the available electric commands are: + `erlang-electric-comma' + `erlang-electric-semicolon' + `erlang-electric-gt' + `erlang-electric-newline' + +Should the variable be bound to t, all electric commands +are activated. + +To deactivate all electric commands, set this variable to nil.") + +(defvar erlang-electric-newline-inhibit t + "*Set to non-nil to inhibit newline after electric command. + +This is useful since a lot of people press return after executing an +electric command. + +In order to work, the command must also be in the +list `erlang-electric-newline-inhibit-list'. + +Note that commands in this list are required to set the variable +`erlang-electric-newline-inhibit' to nil when the newline shouldn't be +inhibited.") + +(defvar erlang-electric-newline-inhibit-list + '(erlang-electric-semicolon + erlang-electric-comma + erlang-electric-gt) + "*Commands which can inhibit the next newline.") + +(defvar erlang-electric-semicolon-insert-blank-lines nil + "*Number of blank lines inserted before header, or nil. + +This variable controls the behaviour of `erlang-electric-semicolon' +when a new function header is generated. When nil, no blank line is +inserted between the current line and the new header. When bound to a +number it represents the number of blank lines which should be +inserted.") + +(defvar erlang-electric-semicolon-criteria + '(erlang-next-lines-empty-p + erlang-at-keyword-end-p + erlang-at-end-of-function-p) + "*List of functions controlling `erlang-electric-semicolon'. +The functions in this list are called, in order, whenever a semicolon +is typed. Each function in the list is called with no arguments, +and should return one of the following values: + + nil -- no determination made, continue checking + 'stop -- do not create prototype for next line + (anything else) -- insert prototype, and stop checking + +If every function in the list is called with no determination made, +then no prototype is inserted. + +The test is performed by the function `erlang-test-criteria-list'.") + +(defvar erlang-electric-comma-criteria + '(erlang-stop-when-inside-argument-list + erlang-stop-when-at-guard + erlang-next-lines-empty-p + erlang-at-keyword-end-p + erlang-at-end-of-clause-p + erlang-at-end-of-function-p) + "*List of functions controlling `erlang-electric-comma'. +The functions in this list are called, in order, whenever a comma +is typed. Each function in the list is called with no arguments, +and should return one of the following values: + + nil -- no determination made, continue checking + 'stop -- do not create prototype for next line + (anything else) -- insert prototype, and stop checking + +If every function in the list is called with no determination made, +then no prototype is inserted. + +The test is performed by the function `erlang-test-criteria-list'.") + +(defvar erlang-electric-arrow-criteria + '(erlang-next-lines-empty-p + erlang-at-end-of-function-p) + "*List of functions controlling the arrow aspect of `erlang-electric-gt'. +The functions in this list are called, in order, whenever a `>' +is typed. Each function in the list is called with no arguments, +and should return one of the following values: + + nil -- no determination made, continue checking + 'stop -- do not create prototype for next line + (anything else) -- insert prototype, and stop checking + +If every function in the list is called with no determination made, +then no prototype is inserted. + +The test is performed by the function `erlang-test-criteria-list'.") + +(defvar erlang-electric-newline-criteria + '(t) + "*List of functions controlling `erlang-electric-newline'. + +The electric newline commands indents the next line. Should the +current line begin with a comment the comment start is copied to +the newly created line. + +The functions in this list are called, in order, whenever a comma +is typed. Each function in the list is called with no arguments, +and should return one of the following values: + + nil -- no determination made, continue checking + 'stop -- do not create prototype for next line + (anything else) -- trigger the electric command. + +If every function in the list is called with no determination made, +then no prototype is inserted. Should the atom t be a member of the +list, it is treated as a function triggering the electric command. + +The test is performed by the function `erlang-test-criteria-list'.") + +(defvar erlang-next-lines-empty-threshold 2 + "*Number of blank lines required to activate an electric command. + +Actually, this value controls the behaviour of the function +`erlang-next-lines-empty-p' which normally is a member of the +criteria lists controlling the electric commands. (Please see +the variables `erlang-electric-semicolon-criteria' and +`erlang-electric-comma-criteria'.) + +The variable is bound to a threshold value, a number, representing the +number of lines which must be empty. + +Setting this variable to zero, electric commands will always be +triggered by `erlang-next-lines-empty-p', unless inhibited by other +rules. + +Should this variable be nil, `erlang-next-lines-empty-p' will never +trigger an electric command. The same effect would be reached if the +function `erlang-next-lines-empty-p' would be removed from the criteria +lists. + +Note that even if `erlang-next-lines-empty-p' should not trigger an +electric command, other functions in the criteria list could.") + +(defvar erlang-new-clause-with-arguments nil + "*Non-nil means that the arguments are cloned when a clause is generated. + +A new function header can be generated by calls to the function +`erlang-generate-new-clause' and by use of the electric semicolon.") + +(defvar erlang-compile-use-outdir t + "*When nil, go to the directory containing source file when compiling. + +This is a workaround for a bug in the `outdir' option of compile. If the +outdir is not in the current load path, Erlang doesn't load the object +module after it has been compiled. + +To activate the workaround, place the following in your `~/.emacs' file: + (setq erlang-compile-use-outdir nil)") + +(defvar erlang-indent-level 4 + "*Indentation of Erlang calls/clauses within blocks.") + +(defvar erlang-indent-guard 2 + "*Indentation of Erlang guards.") + +(defvar erlang-argument-indent 2 + "*Indentation of the first argument in a function call. +When nil, indent to the column after the `(' of the +function.") + +(defvar erlang-tab-always-indent t + "*Non-nil means TAB in Erlang mode should always re-indent the current line, +regardless of where in the line point is when the TAB command is used.") + +(defvar erlang-error-regexp-alist + '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2))) + "*Patterns for matching Erlang errors.") + +(defvar erlang-man-inhibit (eq system-type 'windows-nt) + "Inhibit the creation of the Erlang Manual Pages menu. + +The Windows distribution of Erlang does not include man pages, hence +there is no attempt to create the menu.") + +(defvar erlang-man-dirs + '(("Man - Commands" "/man/man1" t) + ("Man - Modules" "/man/man3" t) + ("Man - Files" "/man/man4" t) + ("Man - Applications" "/man/man6" t)) + "*The man directories displayed in the Erlang menu. + +Each item in the list should be a list with three elements, the first +the name of the menu, the second the directory, and the last a flag. +Should the flag the nil, the directory is absolute, should it be non-nil +the directory is relative to the variable `erlang-root-dir'.") + +(defvar erlang-man-max-menu-size 35 + "*The maximum number of menu items in one menu allowed.") + +(defvar erlang-man-display-function 'erlang-man-display + "*Function used to display man page. + +The function is called with one argument, the name of the file +containing the man page. Use this variable when the default +function, `erlang-man-display', does not work on your system.") + +(defvar erlang-compile-extra-opts '() + "*Additional options to the compilation command. +This is an elisp list of options. Each option can be either: +- an atom +- a dotted pair +- a string +Example: '(bin_opt_info (i . \"/path1/include\") (i . \"/path2/include\"))") + +(eval-and-compile + (defvar erlang-regexp-modern-p + (if (> erlang-emacs-major-version 21) t nil) + "Non-nil when this version of Emacs uses a modern version of regexp. +Supporting \_< and \_> This is determined by checking the version of Emacs used.")) + +(eval-and-compile + (defconst erlang-atom-quoted-regexp + "'\\(?:[^\\']\\|\\(?:\\\\.\\)\\)*'" + "Regexp describing a single-quoted atom")) + +(eval-and-compile + (defconst erlang-atom-regular-regexp + (if erlang-regexp-modern-p + "\\_<[[:lower:]]\\(?:\\sw\\|\\s_\\)*\\_>" + "\\<[[:lower:]]\\(?:\\sw\\|\\s_\\)*\\>") + "Regexp describing a regular (non-quoted) atom")) + +(eval-and-compile + (defconst erlang-atom-regexp + (concat "\\(" erlang-atom-quoted-regexp "\\|" + erlang-atom-regular-regexp "\\)") + "Regexp describing an Erlang atom.")) + +(eval-and-compile + (defconst erlang-atom-regexp-matches 1 + "Number of regexp parenthesis pairs in `erlang-atom-regexp'. + +This is used to determine parenthesis matches in complex regexps which +contains `erlang-atom-regexp'.")) + + +(eval-and-compile + (defconst erlang-variable-regexp + (if erlang-regexp-modern-p + "\\_<\\([[:upper:]_]\\(?:\\sw\\|\\s_\\)*\\)\\_>" + "\\<\\([[:upper:]_]\\(?:\\sw\\|\\s_\\)*\\)\\>") + "Regexp which should match an Erlang variable. + +The regexp must be surrounded with a pair of regexp parentheses.")) + +(eval-and-compile + (defconst erlang-variable-regexp-matches 1 + "Number of regexp parenthesis pairs in `erlang-variable-regexp'. + +This is used to determine matches in complex regexps which contains +`erlang-variable-regexp'.")) + + +(eval-and-compile + (defun erlang-regexp-opt (strings &optional paren) + "Like `regexp-opt', except if PAREN is `symbols', then the +resulting regexp is surrounded by \\_< and \\_>." + (if (eq paren 'symbols) + (if erlang-regexp-modern-p + (concat "\\_<" (regexp-opt strings t) "\\_>") + (concat "\\<" (regexp-opt strings t) "\\>")) + (regexp-opt strings paren)))) + + +(eval-and-compile + (defvar erlang-keywords + '("after" + "begin" + "catch" + "case" + "cond" + "end" + "fun" + "if" + "let" + "of" + "query" + "receive" + "try" + "when") + "Erlang reserved keywords")) + +(eval-and-compile + (defconst erlang-keywords-regexp (erlang-regexp-opt erlang-keywords 'symbols))) + +(eval-and-compile + (defvar erlang-operators + '("and" + "andalso" + "band" + "bnot" + "bor" + "bsl" + "bsr" + "bxor" + "div" + "not" + "or" + "orelse" + "rem" + "xor") + "Erlang operators")) +;; What about these? +;; '+' '-' '*' '/' '>', '>=', '<', '=<', '=:=', '==', '=/=', '/=' + +(eval-and-compile + (defconst erlang-operators-regexp (erlang-regexp-opt erlang-operators 'symbols))) + + +(eval-and-compile + (defvar erlang-guards + '("is_atom" + "is_binary" + "is_bitstring" + "is_boolean" + "is_float" + "is_function" + "is_integer" + "is_list" + "is_number" + "is_pid" + "is_port" + "is_record" + "is_reference" + "is_tuple" + "atom" + "binary" + "bitstring" + "boolean" + ;;"float" ; Not included to avoid clashes with the bif float/1 + "function" + "integer" + "list" + "number" + "pid" + "port" + "record" + "reference" + "tuple") + "Erlang guards")) + +(eval-and-compile + (defconst erlang-guards-regexp (erlang-regexp-opt erlang-guards 'symbols))) + + +(eval-and-compile + (defvar erlang-predefined-types + '("any" + "arity" + "byte" + "char" + "cons" + "deep_string" + "maybe_improper_list" + "mfa" + "nil" + "none" + "non_neg_integer" + "nonempty_list" + "nonempty_improper_list" + "nonempty_maybe_improper_list" + "string" + "timeout") + "Erlang type specs types")) + +(eval-and-compile + (defconst erlang-predefined-types-regexp + (erlang-regexp-opt erlang-predefined-types 'symbols))) + + +(eval-and-compile + (defvar erlang-int-bifs + '("abs" + "adler32" + "adler32_combine" + "alive" + "apply" + "atom_to_binary" + "atom_to_list" + "binary_to_atom" + "binary_to_existing_atom" + "binary_to_list" + "binary_to_term" + "bit_size" + "bitstring_to_list" + "byte_size" + "check_process_code" + "contact_binary" + "crc32" + "crc32_combine" + "date" + "decode_packet" + "delete_module" + "disconnect_node" + "element" + "erase" + "exit" + "float" + "float_to_list" + "garbage_collect" + "get" + "get_keys" + "group_leader" + "halt" + "hd" + "integer_to_list" + "internal_bif" + "iolist_size" + "iolist_to_binary" + "is_alive" + "is_atom" + "is_binary" + "is_bitstring" + "is_boolean" + "is_float" + "is_function" + "is_integer" + "is_list" + "is_number" + "is_pid" + "is_port" + "is_process_alive" + "is_record" + "is_reference" + "is_tuple" + "length" + "link" + "list_to_atom" + "list_to_binary" + "list_to_bitstring" + "list_to_existing_atom" + "list_to_float" + "list_to_integer" + "list_to_pid" + "list_to_tuple" + "load_module" + "make_ref" + "module_loaded" + "monitor_node" + "node" + "node_link" + "node_unlink" + "nodes" + "notalive" + "now" + "open_port" + "pid_to_list" + "port_close" + "port_command" + "port_connect" + "port_control" + "pre_loaded" + "process_flag" + "process_info" + "processes" + "purge_module" + "put" + "register" + "registered" + "round" + "self" + "setelement" + "size" + "spawn" + "spawn_link" + "spawn_monitor" + "spawn_opt" + "split_binary" + "statistics" + "term_to_binary" + "time" + "throw" + "tl" + "trunc" + "tuple_size" + "tuple_to_list" + "unlink" + "unregister" + "whereis") + "Erlang built-in functions (BIFs)")) + +(eval-and-compile + (defconst erlang-int-bif-regexp (erlang-regexp-opt erlang-int-bifs 'symbols))) + + +(eval-and-compile + (defvar erlang-ext-bifs + '("append_element" + "bump_reductions" + "cancel_timer" + "demonitor" + "display" + "fun_info" + "fun_to_list" + "function_exported" + "get_cookie" + "get_stacktrace" + "hash" + "integer_to_list" + "is_builtin" + "list_to_integer" + "loaded" + "localtime" + "localtime_to_universaltime" + "make_tuple" + "max" + "md5" + "md5_final" + "md5_init" + "md5_update" + "memory" + "min" + "monitor" + "monitor_node" + "phash" + "phash2" + "port_call" + "port_info" + "port_to_list" + "ports" + "process_display" + "read_timer" + "ref_to_list" + "resume_process" + "send" + "send_after" + "send_nosuspend" + "set_cookie" + "start_timer" + "suspend_process" + "system_flag" + "system_info" + "system_monitor" + "system_profile" + "trace" + "trace_delivered" + "trace_info" + "trace_pattern" + "universaltime" + "universaltime_to_localtime" + "yield") + "Erlang built-in functions (BIFs) that needs erlang: prefix")) + +(eval-and-compile + (defconst erlang-ext-bif-regexp + (erlang-regexp-opt (append erlang-int-bifs erlang-ext-bifs) 'symbols))) + + +(defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(") + "Regexp which should match beginning of a clause.") + +(defvar erlang-file-name-extension-regexp "\\.[eh]rl$" + "*Regexp which should match an Erlang file name. + +This regexp is used when an Erlang module name is extracted from the +name of an Erlang source file. + +The regexp should only match the section of the file name which should +be excluded from the module name. + +To match all files set this variable to \"\\\\(\\\\..*\\\\|\\\\)$\". +The matches all except the extension. This is useful if the Erlang +tags system should interpret tags on the form `module:tag' for +files written in other languages than Erlang.") + +(defvar erlang-inferior-shell-split-window t + "*If non-nil, when starting an inferior shell, split windows. +If nil, the inferior shell replaces the window. This is the traditional +behaviour.") + +(defvar erlang-mode-map nil + "*Keymap used in Erlang mode.") +(defvar erlang-mode-abbrev-table nil + "Abbrev table in use in Erlang-mode buffers.") +(defvar erlang-mode-syntax-table nil + "Syntax table in use in Erlang-mode buffers.") + +(defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist) + "Non-nil means use `compilation-minor-mode' in Erlang shell.") + +;; Tempo skeleton templates: + +(defvar erlang-tempo-tags nil + "Tempo tags for erlang mode") + +(defvar erlang-skel + '(("If" "if" erlang-skel-if) + ("Case" "case" erlang-skel-case) + ("Receive" "receive" erlang-skel-receive) + ("Receive After" "after" erlang-skel-receive-after) + ("Receive Loop" "loop" erlang-skel-receive-loop) + ("Module" "module" erlang-skel-module) + ("Author" "author" erlang-skel-author) + () + ("Small Header" "small-header" + erlang-skel-small-header erlang-skel-header) + ("Normal Header" "normal-header" + erlang-skel-normal-header erlang-skel-header) + ("Large Header" "large-header" + erlang-skel-large-header erlang-skel-header) + () + ("Small Server" "small-server" + erlang-skel-small-server erlang-skel-header) + () + ("Application" "application" + erlang-skel-application erlang-skel-header) + ("Supervisor" "supervisor" + erlang-skel-supervisor erlang-skel-header) + ("supervisor_bridge" "supervisor-bridge" + erlang-skel-supervisor-bridge erlang-skel-header) + ("gen_server" "generic-server" + erlang-skel-generic-server erlang-skel-header) + ("gen_event" "gen-event" + erlang-skel-gen-event erlang-skel-header) + ("gen_fsm" "gen-fsm" + erlang-skel-gen-fsm erlang-skel-header) + ("Library module" "gen-lib" + erlang-skel-lib erlang-skel-header) + ("Corba callback" "gen-corba-cb" + erlang-skel-corba-callback erlang-skel-header) + ("Small Common Test suite" "ct-test-suite-s" + erlang-skel-ct-test-suite-s erlang-skel-header) + ("Large Common Test suite" "ct-test-suite-l" + erlang-skel-ct-test-suite-l erlang-skel-header) + ("Erlang TS test suite" "ts-test-suite" + erlang-skel-ts-test-suite erlang-skel-header) + ) + "*Description of all skeleton templates. +Both functions and menu entries will be created. + +Each entry in `erlang-skel' should be a list with three or four +elements, or the empty list. + +The first element is the name which shows up in the menu. The second +is the `tempo' identifier (The string \"erlang-\" will be added in +front of it). The third is the skeleton descriptor, a variable +containing `tempo' attributes as described in the function +`tempo-define-template'. The optional fourth elements denotes a +function which should be called when the menu is selected. + +Functions corresponding to every template will be created. The name +of the function will be `tempo-template-erlang-X' where `X' is the +tempo identifier as specified in the second argument of the elements +in this list. + +A list with zero elements means that the a horizontal line should +be placed in the menu.") + +;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH! +;; What's wrong with that? RFC 822 says it's legal. [sverkerw] +;; This needs to use the customized value. If that's not sane, things like +;; add-log will lose anyhow. Avoid it if there _is_ a paren. +(defvar erlang-skel-mail-address + (if (or (not user-mail-address) (string-match "(" user-mail-address)) + (concat (user-login-name) "@" + (or (and (boundp 'mail-host-address) + mail-host-address) + (system-name))) + user-mail-address) + "Mail address of the user.") + +;; Expression templates: +(defvar erlang-skel-case + '((erlang-skel-skip-blank) o > + "case " p " of" n> p "_ ->" n> p "ok" n> "end" p) + "*The skeleton of a `case' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-if + '((erlang-skel-skip-blank) o > + "if" n> p " ->" n> p "ok" n> "end" p) + "The skeleton of an `if' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive + '((erlang-skel-skip-blank) o > + "receive" n> p "_ ->" n> p "ok" n> "end" p) + "*The skeleton of a `receive' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive-after + '((erlang-skel-skip-blank) o > + "receive" n> p "_ ->" n> p "ok" n> "after " p "T ->" n> + p "ok" n> "end" p) + "*The skeleton of a `receive' expression with an `after' clause. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive-loop + '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n> + "loop(" p ")" n> "end.") + "*The skeleton of a simple `receive' loop. +Please see the function `tempo-define-template'.") + + +;; Attribute templates + +(defvar erlang-skel-module + '(& "-module(" + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ")." n) + "*The skeleton of a `module' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-author + '(& "-author('" erlang-skel-mail-address "')." n) + "*The skeleton of a `author' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-vc nil + "*The skeleton template to generate a version control attribute. +The default is to insert nothing. Example of usage: + + (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n) + +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-export + '(& "-export([" n> "])." n) + "*The skeleton of an `export' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-import + '(& "%%-import(Module, [Function/Arity, ...])." n) + "*The skeleton of an `import' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-compile nil + ;; '(& "%%-compile(export_all)." n) + "*The skeleton of a `compile' attribute. +Please see the function `tempo-define-template'.") + + +;; Comment templates. + +(defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy + "*Function which returns date string. +Look in the module `time-stamp' for a battery of functions.") + +(defvar erlang-skel-copyright-comment '() + "*The template for a copyright line in the header, normally empty. +This variable should be bound to a `tempo' template, for example: + '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n) + +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-created-comment + '(& "%%% Created : " (funcall erlang-skel-date-function) " by " + (user-full-name) " <" erlang-skel-mail-address ">" n) + "*The template for the \"Created:\" comment line.") + +(defvar erlang-skel-author-comment + '(& "%%% Author : " (user-full-name) " <" erlang-skel-mail-address ">" n) + "*The template for creating the \"Author:\" line in the header. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-file-comment + '(& "%%% File : " (file-name-nondirectory buffer-file-name) n) +"*The template for creating the \"Module:\" line in the header. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-small-header + '(o (erlang-skel-include erlang-skel-module) + ;; erlang-skel-author) + n + (erlang-skel-include erlang-skel-compile + ;; erlang-skel-export + erlang-skel-vc)) + "*The template of a small header without any comments. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-normal-header + '(o (erlang-skel-include erlang-skel-copyright-comment + erlang-skel-file-comment + erlang-skel-author-comment) + "%%% Description : " p n + (erlang-skel-include erlang-skel-created-comment) n + (erlang-skel-include erlang-skel-small-header) n) + "*The template of a normal header. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-large-header + '(o (erlang-skel-separator) + (erlang-skel-include erlang-skel-copyright-comment + erlang-skel-file-comment + erlang-skel-author-comment) + "%%% Description : " p n + "%%%" n + (erlang-skel-include erlang-skel-created-comment) + (erlang-skel-separator) + (erlang-skel-include erlang-skel-small-header) ) + "*The template of a large header. +Please see the function `tempo-define-template'.") + + +;; Server templates. + +(defvar erlang-skel-small-server + '((erlang-skel-include erlang-skel-large-header) + "-export([start/0,init/1])." n n n + "start() ->" n> "spawn(" (erlang-get-module-from-file-name) + ", init, [self()])." n n + "init(From) ->" n> + "loop(From)." n n + "loop(From) ->" n> + "receive" n> + p "_ ->" n> + "loop(From)" n> + "end." + ) + "*Template of a small server. +Please see the function `tempo-define-template'.") + +;; Behaviour templates. + +(defvar erlang-skel-application + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(application)." n n + "%% Application callbacks" n + "-export([start/2, stop/1])." n n + (erlang-skel-double-separator 2) + "%% Application callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start(Type, StartArgs) -> {ok, Pid} |" n + "%% {ok, Pid, State} |" n + "%% {error, Reason}" n + "%% Description: This function is called whenever an application " n + "%% is started using application:start/1,2, and should start the processes" n + "%% of the application. If the application is structured according to the" n + "%% OTP design principles as a supervision tree, this means starting the" n + "%% top supervisor of the tree." n + (erlang-skel-separator 2) + "start(_Type, StartArgs) ->" n> + "case 'TopSupervisor':start_link(StartArgs) of" n> + "{ok, Pid} -> " n> + "{ok, Pid};" n> + "Error ->" n> + "Error" n> + "end." n + n + (erlang-skel-separator 2) + "%% Function: stop(State) -> void()" n + "%% Description: This function is called whenever an application" n + "%% has stopped. It is intended to be the opposite of Module:start/2 and" n + "%% should do any necessary cleaning up. The return value is ignored. "n + (erlang-skel-separator 2) + "stop(_State) ->" n> + "ok." n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of an application behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-supervisor + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% Supervisor callbacks" n + "-export([init/1])." n n + + "-define(SERVER, ?MODULE)." n n + + (erlang-skel-double-separator 2) + "%% API functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n + "%% Description: Starts the supervisor" n + (erlang-skel-separator 2) + "start_link() ->" n> + "supervisor:start_link({local, ?SERVER}, ?MODULE, [])." n + n + (erlang-skel-double-separator 2) + "%% Supervisor callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Func: init(Args) -> {ok, {SupFlags, [ChildSpec]}} |" n + "%% ignore |" n + "%% {error, Reason}" n + "%% Description: Whenever a supervisor is started using "n + "%% supervisor:start_link/[2,3], this function is called by the new process "n + "%% to find out about restart strategy, maximum restart frequency and child "n + "%% specifications." n + (erlang-skel-separator 2) + "init([]) ->" n> + "AChild = {'AName',{'AModule',start_link,[]}," n> + "permanent,2000,worker,['AModule']}," n> + "{ok,{{one_for_all,0,1}, [AChild]}}." n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of an supervisor behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-supervisor-bridge + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor_bridge)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% supervisor_bridge callbacks" n + "-export([init/1, terminate/2])." n n + + "-define(SERVER, ?MODULE)." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator 2) + "%% API" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n + "%% Description: Starts the supervisor bridge" n + (erlang-skel-separator 2) + "start_link() ->" n> + "supervisor_bridge:start_link({local, ?SERVER}, ?MODULE, [])." n + n + (erlang-skel-double-separator 2) + "%% supervisor_bridge callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Funcion: init(Args) -> {ok, Pid, State} |" n + "%% ignore |" n + "%% {error, Reason} " n + "%% Description:Creates a supervisor_bridge process, linked to the calling" n + "%% process, which calls Module:init/1 to start the subsystem. To ensure a" n + "%% synchronized start-up procedure, this function does not return until" n + "%% Module:init/1 has returned. " n + (erlang-skel-separator 2) + "init([]) ->" n> + "case 'AModule':start_link() of" n> + "{ok, Pid} ->" n> + "{ok, Pid, #state{}};" n> + "Error ->" n> + "Error" n> + "end." n + n + (erlang-skel-separator 2) + "%% Func: terminate(Reason, State) -> void()" n + "%% Description:This function is called by the supervisor_bridge when it is"n + "%% about to terminate. It should be the opposite of Module:init/1 and stop"n + "%% the subsystem and do any necessary cleaning up.The return value is ignored." + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "'AModule':stop()," n> + "ok." n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of an supervisor_bridge behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-generic-server + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_server)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% gen_server callbacks" n + "-export([init/1, handle_call/3, handle_cast/2, " + "handle_info/2," n> + "terminate/2, code_change/3])." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator 2) + "%% API" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n + "%% Description: Starts the server" n + (erlang-skel-separator 2) + "start_link() ->" n> + "gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])." n + n + (erlang-skel-double-separator 2) + "%% gen_server callbacks" n + (erlang-skel-double-separator 2) + n + (erlang-skel-separator 2) + "%% Function: init(Args) -> {ok, State} |" n + "%% {ok, State, Timeout} |" n + "%% ignore |" n + "%% {stop, Reason}" n + "%% Description: Initiates the server" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Function: " + "%% handle_call(Request, From, State) -> {reply, Reply, State} |" n + "%% {reply, Reply, State, Timeout} |" n + "%% {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, Reply, State} |" n + "%% {stop, Reason, State}" n + "%% Description: Handling call messages" n + (erlang-skel-separator 2) + "handle_call(_Request, _From, State) ->" n> + "Reply = ok," n> + "{reply, Reply, State}." n + n + (erlang-skel-separator 2) + "%% Function: handle_cast(Msg, State) -> {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State}" n + "%% Description: Handling cast messages" n + + (erlang-skel-separator 2) + "handle_cast(_Msg, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Function: handle_info(Info, State) -> {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State}" n + "%% Description: Handling all non call/cast messages" n + (erlang-skel-separator 2) + "handle_info(_Info, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Function: terminate(Reason, State) -> void()" n + "%% Description: This function is called by a gen_server when it is about to"n + "%% terminate. It should be the opposite of Module:init/1 and do any necessary"n + "%% cleaning up. When it returns, the gen_server terminates with Reason." n + "%% The return value is ignored." n + + (erlang-skel-separator 2) + "terminate(_Reason, _State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}" n + "%% Description: Convert process state when code is changed" n + (erlang-skel-separator 2) + "code_change(_OldVsn, State, _Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%%% Internal functions" n + (erlang-skel-separator 2) + ) + "*The template of a generic server. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-gen-event + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_event)." n + + "%% API" n + "-export([start_link/0, add_handler/0])." n n + + "%% gen_event callbacks" n + "-export([init/1, handle_event/2, handle_call/2, " n> + "handle_info/2, terminate/2, code_change/3])." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator 2) + "%% gen_event callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link() -> {ok,Pid} | {error,Error} " n + "%% Description: Creates an event manager." n + (erlang-skel-separator 2) + "start_link() ->" n> + "gen_event:start_link({local, ?SERVER}). " n + n + (erlang-skel-separator 2) + "%% Function: add_handler() -> ok | {'EXIT',Reason} | term()" n + "%% Description: Adds an event handler" n + (erlang-skel-separator 2) + "add_handler() ->" n> + "gen_event:add_handler(?SERVER, ?MODULE, [])." n + n + (erlang-skel-double-separator 2) + "%% gen_event callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: init(Args) -> {ok, State}" n + "%% Description: Whenever a new event handler is added to an event manager,"n + "%% this function is called to initialize the event handler." n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Function: "n + "%% handle_event(Event, State) -> {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |"n + "%% remove_handler" n + "%% Description:Whenever an event manager receives an event sent using"n + "%% gen_event:notify/2 or gen_event:sync_notify/2, this function is called for"n + "%% each installed event handler to handle the event. "n + (erlang-skel-separator 2) + "handle_event(_Event, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%% Function: " n + "%% handle_call(Request, State) -> {ok, Reply, State} |" n + "%% {swap_handler, Reply, Args1, State1, "n + "%% Mod2, Args2} |" n + "%% {remove_handler, Reply}" n + "%% Description: Whenever an event manager receives a request sent using"n + "%% gen_event:call/3,4, this function is called for the specified event "n + "%% handler to handle the request."n + (erlang-skel-separator 2) + "handle_call(_Request, State) ->" n> + "Reply = ok," n> + "{ok, Reply, State}." n + n + (erlang-skel-separator 2) + "%% Function: " n + "%% handle_info(Info, State) -> {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |" n + "%% remove_handler" n + "%% Description: This function is called for each installed event handler when"n + "%% an event manager receives any other message than an event or a synchronous"n + "%% request (or a system message)."n + (erlang-skel-separator 2) + "handle_info(_Info, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%% Function: terminate(Reason, State) -> void()" n + "%% Description:Whenever an event handler is deleted from an event manager,"n + "%% this function is called. It should be the opposite of Module:init/1 and "n + "%% do any necessary cleaning up. " n + (erlang-skel-separator 2) + "terminate(_Reason, _State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} " n + "%% Description: Convert process state when code is changed" n + (erlang-skel-separator 2) + "code_change(_OldVsn, State, _Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%%% Internal functions" n + (erlang-skel-separator 2) + ) + "*The template of a gen_event. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-gen-fsm + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_fsm)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% gen_fsm callbacks" n + "-export([init/1, state_name/2, state_name/3, handle_event/3," n> + "handle_sync_event/4, handle_info/3, terminate/3, code_change/4])." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator 2) + "%% API" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link() -> ok,Pid} | ignore | {error,Error}" n + "%% Description:Creates a gen_fsm process which calls Module:init/1 to"n + "%% initialize. To ensure a synchronized start-up procedure, this function" n + "%% does not return until Module:init/1 has returned. " n + (erlang-skel-separator 2) + "start_link() ->" n> + "gen_fsm:start_link({local, ?SERVER}, ?MODULE, [], [])." n + n + (erlang-skel-double-separator 2) + "%% gen_fsm callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: init(Args) -> {ok, StateName, State} |" n + "%% {ok, StateName, State, Timeout} |" n + "%% ignore |" n + "%% {stop, StopReason} " n + "%% Description:Whenever a gen_fsm is started using gen_fsm:start/[3,4] or"n + "%% gen_fsm:start_link/3,4, this function is called by the new process to "n + "%% initialize. " n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, state_name, #state{}}." n + n + (erlang-skel-separator 2) + "%% Function: "n + "%% state_name(Event, State) -> {next_state, NextStateName, NextState}|" n + "%% {next_state, NextStateName, " n + "%% NextState, Timeout} |" n + "%% {stop, Reason, NewState}" n + "%% Description:There should be one instance of this function for each possible"n + "%% state name. Whenever a gen_fsm receives an event sent using" n + "%% gen_fsm:send_event/2, the instance of this function with the same name as"n + "%% the current state name StateName is called to handle the event. It is also "n + "%% called if a timeout occurs. " n + (erlang-skel-separator 2) + "state_name(_Event, State) ->" n> + "{next_state, state_name, State}." n + n + (erlang-skel-separator 2) + "%% Function:" n + "%% state_name(Event, From, State) -> {next_state, NextStateName, NextState} |"n + "%% {next_state, NextStateName, " n + "%% NextState, Timeout} |" n + "%% {reply, Reply, NextStateName, NextState}|"n + "%% {reply, Reply, NextStateName, " n + "%% NextState, Timeout} |" n + "%% {stop, Reason, NewState}|" n + "%% {stop, Reason, Reply, NewState}" n + "%% Description: There should be one instance of this function for each" n + "%% possible state name. Whenever a gen_fsm receives an event sent using" n + "%% gen_fsm:sync_send_event/2,3, the instance of this function with the same"n + "%% name as the current state name StateName is called to handle the event." n + (erlang-skel-separator 2) + "state_name(_Event, _From, State) ->" n> + "Reply = ok," n> + "{reply, Reply, state_name, State}." n + n + (erlang-skel-separator 2) + "%% Function: " n + "%% handle_event(Event, StateName, State) -> {next_state, NextStateName, "n + "%% NextState} |" n + "%% {next_state, NextStateName, "n + "%% NextState, Timeout} |" n + "%% {stop, Reason, NewState}" n + "%% Description: Whenever a gen_fsm receives an event sent using"n + "%% gen_fsm:send_all_state_event/2, this function is called to handle"n + "%% the event." n + (erlang-skel-separator 2) + "handle_event(_Event, StateName, State) ->" n> + "{next_state, StateName, State}." n + n + (erlang-skel-separator 2) + "%% Function: " n + "%% handle_sync_event(Event, From, StateName, "n + "%% State) -> {next_state, NextStateName, NextState} |" n + "%% {next_state, NextStateName, NextState, " n + "%% Timeout} |" n + "%% {reply, Reply, NextStateName, NextState}|" n + "%% {reply, Reply, NextStateName, NextState, " n + "%% Timeout} |" n + "%% {stop, Reason, NewState} |" n + "%% {stop, Reason, Reply, NewState}" n + "%% Description: Whenever a gen_fsm receives an event sent using"n + "%% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle"n + "%% the event."n + (erlang-skel-separator 2) + "handle_sync_event(Event, From, StateName, State) ->" n> + "Reply = ok," n> + "{reply, Reply, StateName, State}." n + n + (erlang-skel-separator 2) + "%% Function: " n + "%% handle_info(Info,StateName,State)-> {next_state, NextStateName, NextState}|" n + "%% {next_state, NextStateName, NextState, "n + "%% Timeout} |" n + "%% {stop, Reason, NewState}" n + "%% Description: This function is called by a gen_fsm when it receives any"n + "%% other message than a synchronous or asynchronous event"n + "%% (or a system message)." n + (erlang-skel-separator 2) + "handle_info(_Info, StateName, State) ->" n> + "{next_state, StateName, State}." n + n + (erlang-skel-separator 2) + "%% Function: terminate(Reason, StateName, State) -> void()" n + "%% Description:This function is called by a gen_fsm when it is about"n + "%% to terminate. It should be the opposite of Module:init/1 and do any"n + "%% necessary cleaning up. When it returns, the gen_fsm terminates with"n + "%% Reason. The return value is ignored." n + (erlang-skel-separator 2) + "terminate(_Reason, _StateName, _State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Function:" n + "%% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState}" n + "%% Description: Convert process state when code is changed" n + (erlang-skel-separator 2) + "code_change(_OldVsn, StateName, State, _Extra) ->" n> + "{ok, StateName, State}." n + n + (erlang-skel-separator 2) + "%%% Internal functions" n + (erlang-skel-separator 2) + ) + "*The template of a gen_fsm. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-lib + '((erlang-skel-include erlang-skel-large-header) + + "%% API" n + "-export([])." n n + + (erlang-skel-double-separator 2) + "%% API" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: " n + "%% Description:" n + (erlang-skel-separator 2) + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-corba-callback + '((erlang-skel-include erlang-skel-large-header) + "%% Include files" n n + + "%% API" n + "-export([])." n n + + "%% Corba callbacks" n + "-export([init/1, terminate/2, code_change/3])." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator 2) + "%% Corba callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: init(Args) -> {ok, State} |" n + "%% {ok, State, Timeout} |" n + "%% ignore |" n + "%% {stop, Reason}" n + "%% Description: Initiates the server" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Function: terminate(Reason, State) -> void()" n + "%% Description: Shutdown the server" n + (erlang-skel-separator 2) + "terminate(_Reason, _State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} " n + "%% Description: Convert process state when code is changed" n + (erlang-skel-separator 2) + "code_change(_OldVsn, State, _Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-ts-test-suite + '((erlang-skel-include erlang-skel-large-header) + "%% Note: This directive should only be used in test suites." n + "-compile(export_all)." n n + + "-include(\"test_server.hrl\")." n n + + (erlang-skel-separator 2) + "%% TEST SERVER CALLBACK FUNCTIONS" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% Function: init_per_suite(Config0) -> Config1 | {skip,Reason}" n + "%%" n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the suite." n + "%%" n + "%% Description: Initialization before the suite." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + (erlang-skel-separator 2) + "init_per_suite(Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_suite(Config) -> void()" n + "%%" n + "%% Config = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%%" n + "%% Description: Cleanup after the suite." n + (erlang-skel-separator 2) + "end_per_suite(_Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: init_per_testcase(TestCase, Config0) -> Config1 |" n + "%% {skip,Reason}" n + "%% TestCase = atom()" n + "%% Name of the test case that is about to run." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%%" n + "%% Description: Initialization before each test case." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + (erlang-skel-separator 2) + "init_per_testcase(_TestCase, Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_testcase(TestCase, Config) -> void()" n + "%%" n + "%% TestCase = atom()" n + "%% Name of the test case that is finished." n + "%% Config = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%%" n + "%% Description: Cleanup after each test case." n + (erlang-skel-separator 2) + "end_per_testcase(_TestCase, _Config) ->" n > + "ok."n n + + (erlang-skel-separator 2) + "%% Function: all(Clause) -> Descr | Spec | {skip,Reason}" n + "%%" n + "%% Clause = doc | suite" n + "%% Indicates expected return value." n + "%% Descr = [string()] | []" n + "%% String that describes the test suite." n + "%% Spec = [TestCase]" n + "%% A test specification." n + "%% TestCase = ConfCase | atom()" n + "%% Configuration case, or the name of a test case function." n + "%% ConfCase = {conf,Init,Spec,End} |" n + "%% {conf,Properties,Init,Spec,End}" n + "%% Init = End = {Mod,Func} | Func" n + "%% Initialization and cleanup function." n + "%% Mod = Func = atom()" n + "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n + "%% Execution properties of the test cases (may be combined)." n + "%% Shuffle = shuffle | {shuffle,Seed}" n + "%% To get cases executed in random order." n + "%% Seed = {integer(),integer(),integer()}" n + "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n + "%% repeat_until_any_ok | repeat_until_any_fail" n + "%% To get execution of cases repeated." n + "%% N = integer() | forever" n + "%% Reason = term()" n + "%% The reason for skipping the test suite." n + "%%" n + "%% Description: Returns a description of the test suite when" n + "%% Clause == doc, and a test specification (list" n + "%% of the conf and test cases in the suite) when" n + "%% Clause == suite." n + (erlang-skel-separator 2) + "all(doc) -> " n > + "[\"Describe the main purpose of this suite\"];" n n + "all(suite) -> " n > + "[a_test_case]." n n + n + (erlang-skel-separator 2) + "%% TEST CASES" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% Function: TestCase(Arg) -> Descr | Spec | ok | exit() | {skip,Reason}" n + "%%" n + "%% Arg = doc | suite | Config" n + "%% Indicates expected behaviour and return value." n + "%% Config = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Descr = [string()] | []" n + "%% String that describes the test case." n + "%% Spec = [tuple()] | []" n + "%% A test specification, see all/1." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%%" n + "%% Description: Test case function. Returns a description of the test" n + "%% case (doc), then returns a test specification (suite)," n + "%% or performs the actual test (Config)." n + (erlang-skel-separator 2) + "a_test_case(doc) -> " n > + "[\"Describe the main purpose of this test case\"];" n n + "a_test_case(suite) -> " n > + "[];" n n + "a_test_case(Config) when is_list(Config) -> " n > + "ok." n + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-ct-test-suite-l + '((erlang-skel-include erlang-skel-large-header) + "%% Note: This directive should only be used in test suites." n + "-compile(export_all)." n n + + "-include(\"ct.hrl\")." n n + + (erlang-skel-separator 2) + "%% COMMON TEST CALLBACK FUNCTIONS" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% Function: suite() -> Info" n + "%%" n + "%% Info = [tuple()]" n + "%% List of key/value pairs." n + "%%" n + "%% Description: Returns list of tuples to set default properties" n + "%% for the suite." n + "%%" n + "%% Note: The suite/0 function is only meant to be used to return" n + "%% default data values, not perform any other operations." n + (erlang-skel-separator 2) + "suite() ->" n > + "[{timetrap,{minutes,10}}]." n n + + (erlang-skel-separator 2) + "%% Function: init_per_suite(Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%%" n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the suite." n + "%%" n + "%% Description: Initialization before the suite." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + (erlang-skel-separator 2) + "init_per_suite(Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_suite(Config0) -> void() | {save_config,Config1}" n + "%%" n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%%" n + "%% Description: Cleanup after the suite." n + (erlang-skel-separator 2) + "end_per_suite(_Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: init_per_group(GroupName, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%%" n + "%% GroupName = atom()" n + "%% Name of the test case group that is about to run." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding configuration data for the group." n + "%% Reason = term()" n + "%% The reason for skipping all test cases and subgroups in the group." n + "%%" n + "%% Description: Initialization before each test case group." n + (erlang-skel-separator 2) + "init_per_group(_GroupName, Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_group(GroupName, Config0) ->" n + "%% void() | {save_config,Config1}" n + "%%" n + "%% GroupName = atom()" n + "%% Name of the test case group that is finished." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding configuration data for the group." n + "%%" n + "%% Description: Cleanup after each test case group." n + (erlang-skel-separator 2) + "end_per_group(_GroupName, _Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: init_per_testcase(TestCase, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%%" n + "%% TestCase = atom()" n + "%% Name of the test case that is about to run." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%%" n + "%% Description: Initialization before each test case." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + (erlang-skel-separator 2) + "init_per_testcase(_TestCase, Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_testcase(TestCase, Config0) ->" n + "%% void() | {save_config,Config1} | {fail,Reason}" n + "%%" n + "%% TestCase = atom()" n + "%% Name of the test case that is finished." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for failing the test case." n + "%%" n + "%% Description: Cleanup after each test case." n + (erlang-skel-separator 2) + "end_per_testcase(_TestCase, _Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: groups() -> [Group]" n + "%%" n + "%% Group = {GroupName,Properties,GroupsAndTestCases}" n + "%% GroupName = atom()" n + "%% The name of the group." n + "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n + "%% Group properties that may be combined." n + "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n + "%% TestCase = atom()" n + "%% The name of a test case." n + "%% Shuffle = shuffle | {shuffle,Seed}" n + "%% To get cases executed in random order." n + "%% Seed = {integer(),integer(),integer()}" n + "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n + "%% repeat_until_any_ok | repeat_until_any_fail" n + "%% To get execution of cases repeated." n + "%% N = integer() | forever" n + "%%" n + "%% Description: Returns a list of test case group definitions." n + (erlang-skel-separator 2) + "groups() ->" n > + "[]." n n + + (erlang-skel-separator 2) + "%% Function: all() -> GroupsAndTestCases | {skip,Reason}" n + "%%" n + "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n + "%% GroupName = atom()" n + "%% Name of a test case group." n + "%% TestCase = atom()" n + "%% Name of a test case." n + "%% Reason = term()" n + "%% The reason for skipping all groups and test cases." n + "%%" n + "%% Description: Returns the list of groups and test cases that" n + "%% are to be executed." n + (erlang-skel-separator 2) + "all() -> " n > + "[my_test_case]." n n + + n + (erlang-skel-separator 2) + "%% TEST CASES" n + (erlang-skel-separator 2) + n + + (erlang-skel-separator 2) + "%% Function: TestCase() -> Info" n + "%%" n + "%% Info = [tuple()]" n + "%% List of key/value pairs." n + "%%" n + "%% Description: Test case info function - returns list of tuples to set" n + "%% properties for the test case." n + "%%" n + "%% Note: This function is only meant to be used to return a list of" n + "%% values, not perform any other operations." n + (erlang-skel-separator 2) + "my_test_case() -> " n > + "[]." n n + + (erlang-skel-separator 2) + "%% Function: TestCase(Config0) ->" n + "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n + "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n + "%%" n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%% Comment = term()" n + "%% A comment about the test case that will be printed in the html log." n + "%%" n + "%% Description: Test case function. (The name of it must be specified in" n + "%% the all/0 list or in a test case group for the test case" n + "%% to be executed)." n + (erlang-skel-separator 2) + "my_test_case(_Config) -> " n > + "ok." n + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-ct-test-suite-s + '((erlang-skel-include erlang-skel-large-header) + "-compile(export_all)." n n + + "-include(\"ct.hrl\")." n n + + (erlang-skel-separator 2) + "%% Function: suite() -> Info" n + "%% Info = [tuple()]" n + (erlang-skel-separator 2) + "suite() ->" n > + "[{timetrap,{seconds,30}}]." n n + + (erlang-skel-separator 2) + "%% Function: init_per_suite(Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator 2) + "init_per_suite(Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_suite(Config0) -> void() | {save_config,Config1}" n + "%% Config0 = Config1 = [tuple()]" n + (erlang-skel-separator 2) + "end_per_suite(_Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: init_per_group(GroupName, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%% GroupName = atom()" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator 2) + "init_per_group(_GroupName, Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_group(GroupName, Config0) ->" n + "%% void() | {save_config,Config1}" n + "%% GroupName = atom()" n + "%% Config0 = Config1 = [tuple()]" n + (erlang-skel-separator 2) + "end_per_group(_GroupName, _Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: init_per_testcase(TestCase, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%% TestCase = atom()" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator 2) + "init_per_testcase(_TestCase, Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_testcase(TestCase, Config0) ->" n + "%% void() | {save_config,Config1} | {fail,Reason}" n + "%% TestCase = atom()" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator 2) + "end_per_testcase(_TestCase, _Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: groups() -> [Group]" n + "%% Group = {GroupName,Properties,GroupsAndTestCases}" n + "%% GroupName = atom()" n + "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n + "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n + "%% TestCase = atom()" n + "%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}}" n + "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n + "%% repeat_until_any_ok | repeat_until_any_fail" n + "%% N = integer() | forever" n + (erlang-skel-separator 2) + "groups() ->" n > + "[]." n n + + (erlang-skel-separator 2) + "%% Function: all() -> GroupsAndTestCases | {skip,Reason}" n + "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n + "%% GroupName = atom()" n + "%% TestCase = atom()" n + "%% Reason = term()" n + (erlang-skel-separator 2) + "all() -> " n > + "[my_test_case]." n n + + (erlang-skel-separator 2) + "%% Function: TestCase() -> Info" n + "%% Info = [tuple()]" n + (erlang-skel-separator 2) + "my_test_case() -> " n > + "[]." n n + + (erlang-skel-separator 2) + "%% Function: TestCase(Config0) ->" n + "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n + "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + "%% Comment = term()" n + (erlang-skel-separator 2) + "my_test_case(_Config) -> " n > + "ok." n + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +;; Font-lock variables + +;; The next few variables define different Erlang font-lock patterns. +;; They could be appended to form a custom font-lock appearance. +;; +;; The function `erlang-font-lock-set-face' could be used to change +;; the face of a pattern. +;; +;; Note that Erlang strings and atoms are highlighted with using +;; syntactic analysis. + +(defvar erlang-font-lock-keywords-function-header + (list + (list (concat "^" erlang-atom-regexp "\\s-*(") + 1 'font-lock-function-name-face t)) + "Font lock keyword highlighting a function header.") + +(defvar erlang-font-lock-keywords-int-bifs + (list + (list (concat erlang-int-bif-regexp "\\s-*(") + 1 'font-lock-builtin-face)) + "Font lock keyword highlighting built in functions.") + +(defvar erlang-font-lock-keywords-ext-bifs + (list + (list (concat "\\<\\(erlang\\)\\s-*:\\s-*" erlang-ext-bif-regexp "\\s-*(") + '(1 'font-lock-builtin-face) + '(2 'font-lock-builtin-face))) + "Font lock keyword highlighting built in functions.") + +(defvar erlang-font-lock-keywords-int-function-calls + (list + (list (concat erlang-atom-regexp "\\s-*(") + 1 'font-lock-type-face)) + "Font lock keyword highlighting an internal function call.") + +(defvar erlang-font-lock-keywords-ext-function-calls + (list + (list (concat erlang-atom-regexp "\\s-*:\\s-*" + erlang-atom-regexp "\\s-*(") + '(1 'font-lock-type-face) + '(2 'font-lock-type-face))) + "Font lock keyword highlighting an external function call.") + +(defvar erlang-font-lock-keywords-fun-n + (list + (list (concat "\\(" erlang-atom-regexp "/[0-9]+\\)") + 1 'font-lock-type-face)) + "Font lock keyword highlighting a fun descriptor in F/N format.") + +(defvar erlang-font-lock-keywords-operators + (list + (list erlang-operators-regexp + 1 'font-lock-builtin-face)) + "Font lock keyword highlighting Erlang operators.") + +(defvar erlang-font-lock-keywords-dollar + (list + (list "\\(\\$\\([^\\]\\|\\\\\\([^0-7^\n]\\|[0-7]+\\|\\^[a-zA-Z]\\)\\)\\)" + 1 'font-lock-constant-face)) + "Font lock keyword highlighting numbers in ASCII form (e.g. $A).") + +(defvar erlang-font-lock-keywords-arrow + (list + (list "->\\(\\s \\|$\\)" 1 'font-lock-function-name-face)) + "Font lock keyword highlighting clause arrow.") + +(defvar erlang-font-lock-keywords-lc + (list + (list "\\(<-\\|<=\\|||\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face)) + "Font lock keyword highlighting list comprehension operators.") + +(defvar erlang-font-lock-keywords-keywords + (list + (list erlang-keywords-regexp 1 'font-lock-keyword-face)) + "Font lock keyword highlighting Erlang keywords.") + +(defvar erlang-font-lock-keywords-attr + (list + (list (concat "^\\(-" erlang-atom-regexp "\\)\\(\\s-\\|\\.\\|(\\)") + 1 (if (boundp 'font-lock-preprocessor-face) + 'font-lock-preprocessor-face + 'font-lock-function-name-face))) + "Font lock keyword highlighting attributes.") + +(defvar erlang-font-lock-keywords-quotes + (list + (list "`\\([-+a-zA-Z0-9_:*][-+a-zA-Z0-9_:*]+\\)'" + 1 + 'font-lock-keyword-face + t)) + "Font lock keyword highlighting words in single quotes in comments. + +This is not the highlighting of Erlang strings and atoms, which +are highlighted by syntactic analysis.") + +(defvar erlang-font-lock-keywords-guards + (list + (list (concat "[^:]" erlang-guards-regexp "\\s-*(") + 1 'font-lock-builtin-face)) + "Font lock keyword highlighting guards.") + +(defvar erlang-font-lock-keywords-predefined-types + (list + (list (concat "[^:]" erlang-predefined-types-regexp "\\s-*(") + 1 'font-lock-builtin-face)) + "Font lock keyword highlighting predefined types.") + + +(defvar erlang-font-lock-keywords-macros + (list + (list (concat "?\\s-*\\(" erlang-atom-regexp + "\\|" erlang-variable-regexp "\\)") + 1 'font-lock-type-face) + (list (concat "^\\(-\\(?:define\\|ifn?def\\)\\)\\s-*(\\s-*\\(" erlang-atom-regexp + "\\|" erlang-variable-regexp "\\)") + (list 1 'font-lock-preprocessor-face t) + (list 3 'font-lock-type-face t t)) + (list "^-e\\(lse\\|ndif\\)\\>" 0 'font-lock-preprocessor-face t)) + "Font lock keyword highlighting macros. +This must be placed in front of `erlang-font-lock-keywords-vars'.") + +(defvar erlang-font-lock-keywords-records + (list + (list (concat "#\\s *" erlang-atom-regexp) + 1 'font-lock-type-face) + ;; Don't highlight numerical constants. + (list (if erlang-regexp-modern-p + "\\_<[0-9]+#\\([0-9a-zA-Z]+\\)" + "\\<[0-9]+#\\([0-9a-zA-Z]+\\)") + 1 nil t) + (list (concat "^-record\\s-*(\\s-*" erlang-atom-regexp) + 1 'font-lock-type-face)) + "Font lock keyword highlighting Erlang records. +This must be placed in front of `erlang-font-lock-keywords-vars'.") + +(defvar erlang-font-lock-keywords-vars + (list + (list (concat "[^#]" erlang-variable-regexp) ; no numerical constants + 1 'font-lock-variable-name-face)) + "Font lock keyword highlighting Erlang variables. +Must be preceded by `erlang-font-lock-keywords-macros' to work properly.") + +(defvar erlang-font-lock-descr-string + "Font-lock keywords used by Erlang Mode. + +There exists three levels of Font Lock keywords for Erlang: + `erlang-font-lock-keywords-1' - Function headers and reserved keywords. + `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. + `erlang-font-lock-keywords-3' - Variables, macros and records. + `erlang-font-lock-keywords-4' - Function names, Funs, LCs (not Atoms) + +To use a specific level, please set the variable +`font-lock-maximum-decoration' to the appropriate level. Note that the +variable must be set before Erlang mode is activated. + +Example: + (setq font-lock-maximum-decoration 2)") + +(defvar erlang-font-lock-keywords-1 + (append erlang-font-lock-keywords-function-header + erlang-font-lock-keywords-dollar + erlang-font-lock-keywords-arrow + erlang-font-lock-keywords-keywords + ) + ;; DocStringOrig: erlang-font-lock-keywords + erlang-font-lock-descr-string) + +(defvar erlang-font-lock-keywords-2 + (append erlang-font-lock-keywords-1 + erlang-font-lock-keywords-int-bifs + erlang-font-lock-keywords-ext-bifs + erlang-font-lock-keywords-attr + erlang-font-lock-keywords-quotes + erlang-font-lock-keywords-guards + ) + ;; DocStringCopy: erlang-font-lock-keywords + erlang-font-lock-descr-string) + +(defvar erlang-font-lock-keywords-3 + (append erlang-font-lock-keywords-2 + erlang-font-lock-keywords-operators + erlang-font-lock-keywords-macros + erlang-font-lock-keywords-records + erlang-font-lock-keywords-vars + erlang-font-lock-keywords-predefined-types + ) + ;; DocStringCopy: erlang-font-lock-keywords + erlang-font-lock-descr-string) + +(defvar erlang-font-lock-keywords-4 + (append erlang-font-lock-keywords-3 + erlang-font-lock-keywords-int-function-calls + erlang-font-lock-keywords-ext-function-calls + erlang-font-lock-keywords-fun-n + erlang-font-lock-keywords-lc + ) + ;; DocStringCopy: erlang-font-lock-keywords + erlang-font-lock-descr-string) + +(defvar erlang-font-lock-keywords erlang-font-lock-keywords-4 + ;; DocStringCopy: erlang-font-lock-keywords + erlang-font-lock-descr-string) + +(defvar erlang-font-lock-syntax-table nil + "Syntax table used by Font Lock mode. + +The difference between this and the standard Erlang Mode +syntax table is that `_' is treated as part of words by +this syntax table. + +Unfortunately, XEmacs hasn't got support for a special Font +Lock syntax table. The effect is that `apply' in the atom +`foo_apply' will be highlighted as a bif.") + + +;;; Avoid errors while compiling this file. + +;; `eval-when-compile' is not defined in Emacs 18. We define it as a +;; no-op. +(or (fboundp 'eval-when-compile) + (defmacro eval-when-compile (&rest rest) nil)) + +;; These umm...functions are new in Emacs 20. And, yes, until version +;; 19.27 Emacs backquotes were this ugly. + +(or (fboundp 'unless) + (defmacro unless (condition &rest body) + "(unless CONDITION BODY...): If CONDITION is false, do BODY, else return nil." + `((if (, condition) nil ,@body)))) + +(or (fboundp 'when) + (defmacro when (condition &rest body) + "(when CONDITION BODY...): If CONDITION is true, do BODY, else return nil." + `((if (, condition) (progn ,@body) nil)))) + +(or (fboundp 'char-before) + (defmacro char-before (&optional pos) + "Return the character in the current buffer just before POS." + `( (char-after (1- (or ,pos (point))))))) + +;; defvar some obsolete variables, which we still support for +;; backwardscompatibility reasons. +(eval-when-compile + (defvar comment-indent-hook) + (defvar dabbrev-case-fold-search) + (defvar tempo-match-finder) + (defvar compilation-menu-map) + (defvar next-error-last-buffer)) + +(eval-when-compile + (if (or (featurep 'bytecomp) + (featurep 'byte-compile)) + (progn + (cond ((string-match "Lucid\\|XEmacs" emacs-version) + (put 'comment-indent-hook 'byte-obsolete-variable nil) + ;; Do not warn for unused variables + ;; when compiling under XEmacs. + (setq byte-compile-warnings + '(free-vars unresolved callargs redefine)))) + (require 'comint) + (require 'tempo) + (require 'compile)))) + + +(defun erlang-version () + "Return the current version of Erlang mode." + (interactive) + (if (interactive-p) + (message "Erlang mode version %s, written by Anders Lindgren" + erlang-version)) + erlang-version) + + +;;;###autoload +(defun erlang-mode () + "Major mode for editing Erlang source files in Emacs. +It knows about syntax and comment, it can indent code, it is capable +of fontifying the source file, the TAGS commands are aware of Erlang +modules, and the Erlang man pages can be accessed. + +Should this module, \"erlang.el\", be installed properly, Erlang mode +is activated whenever an Erlang source or header file is loaded into +Emacs. To indicate this, the mode line should contain the word +\"Erlang\". + +The main feature of Erlang mode is indentation, press TAB and the +current line will be indented correctly. + +Comments starting with only one `%' are indented to the column stored +in the variable `comment-column'. Comments starting with two `%':s +are indented with the same indentation as code. Comments starting +with at least three `%':s are indented to the first column. + +However, Erlang mode contains much more, this is a list of the most +useful commands: + TAB - Indent the line. + C-c C-q - Indent current function. + M-; - Create a comment at the end of the line. + M-q - Fill a comment, i.e. wrap lines so that they (hopefully) + will look better. + M-a - Goto the beginning of an Erlang clause. + M-C-a - Ditto for function. + M-e - Goto the end of an Erlang clause. + M-C-e - Ditto for function. + M-h - Mark current Erlang clause. + M-C-h - Ditto for function. + C-c C-z - Start, or switch to, an inferior Erlang shell. + C-c C-k - Compile current file. + C-x ` - Next error. + , - Electric comma. + ; - Electric semicolon. + +Erlang mode check the name of the file against the module name when +saving, whenever a mismatch occurs Erlang mode offers to modify the +source. + +The variable `erlang-electric-commands' controls the electric +commands. To deactivate all of them, set it to nil. + +There exists a large number of commands and variables in the Erlang +module. Please press `M-x apropos RET erlang RET' to see a complete +list. Press `C-h f name-of-function RET' and `C-h v name-of-variable +RET'to see the full description of functions and variables, +respectively. + +On entry to this mode the contents of the hook `erlang-mode-hook' is +executed. + +Please see the beginning of the file `erlang.el' for more information +and examples of hooks. + +Other commands: +\\{erlang-mode-map}" + (interactive) + (kill-all-local-variables) + (setq major-mode 'erlang-mode) + (setq mode-name "Erlang") + (erlang-syntax-table-init) + (erlang-keymap-init) + (erlang-electric-init) + (erlang-menu-init) + (erlang-mode-variables) + (erlang-check-module-name-init) + (erlang-add-compilation-alist erlang-error-regexp-alist) + (erlang-man-init) + (erlang-tags-init) + (erlang-font-lock-init) + (erlang-skel-init) + (tempo-use-tag-list 'erlang-tempo-tags) + (run-hooks 'erlang-mode-hook) + (if (zerop (buffer-size)) + (run-hooks 'erlang-new-file-hook)) + ;; Doesn't exist in Emacs v21.4; required by Emacs v23. + (if (boundp 'after-change-major-mode-hook) + (run-hooks 'after-change-major-mode-hook))) + + +(defun erlang-syntax-table-init () + (if (null erlang-mode-syntax-table) + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?# "." table) +;; (modify-syntax-entry ?$ "\\" table) ;; Creates problems with indention afterwards +;; (modify-syntax-entry ?$ "'" table) ;; Creates syntax highlighting and indention problems + (modify-syntax-entry ?$ "/" table) ;; Misses the corner case "string that ends with $" + ;; we have to live with that for now..it is the best alternative + ;; that can be worked around with "string hat ends with \$" + (modify-syntax-entry ?% "<" table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?\' "\"" table) + (modify-syntax-entry ?* "." table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?/ "." table) + (modify-syntax-entry ?: "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?^ "'" table) + + ;; Pseudo bit-syntax: Latin1 double angle quotes as parens. + ;;(modify-syntax-entry ?\253 "(?\273" table) + ;;(modify-syntax-entry ?\273 ")?\253" table) + + (setq erlang-mode-syntax-table table))) + + (set-syntax-table erlang-mode-syntax-table)) + + +(defun erlang-keymap-init () + (if erlang-mode-map + nil + (setq erlang-mode-map (make-sparse-keymap)) + (erlang-mode-commands erlang-mode-map)) + (use-local-map erlang-mode-map)) + + +(defun erlang-mode-commands (map) + (unless (boundp 'indent-line-function) + (define-key map "\t" 'erlang-indent-command)) + (define-key map ";" 'erlang-electric-semicolon) + (define-key map "," 'erlang-electric-comma) + (define-key map "<" 'erlang-electric-lt) + (define-key map ">" 'erlang-electric-gt) + (define-key map "\C-m" 'erlang-electric-newline) + (if (not (boundp 'delete-key-deletes-forward)) + (define-key map "\177" 'backward-delete-char-untabify) + (define-key map [(backspace)] 'backward-delete-char-untabify)) + ;;(unless (boundp 'fill-paragraph-function) + (define-key map "\M-q" 'erlang-fill-paragraph) + (unless (boundp 'beginning-of-defun-function) + (define-key map "\M-\C-a" 'erlang-beginning-of-function) + (define-key map "\M-\C-e" 'erlang-end-of-function) + (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs + (define-key map "\M-\t" 'erlang-complete-tag) + (define-key map "\C-c\M-\t" 'tempo-complete-tag) + (define-key map "\M-+" 'erlang-find-next-tag) + (define-key map "\C-c\M-a" 'erlang-beginning-of-clause) + (define-key map "\C-c\M-b" 'tempo-backward-mark) + (define-key map "\C-c\M-e" 'erlang-end-of-clause) + (define-key map "\C-c\M-f" 'tempo-forward-mark) + (define-key map "\C-c\M-h" 'erlang-mark-clause) + (define-key map "\C-c\C-c" 'comment-region) + (define-key map "\C-c\C-j" 'erlang-generate-new-clause) + (define-key map "\C-c\C-k" 'erlang-compile) + (define-key map "\C-c\C-l" 'erlang-compile-display) + (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) + (define-key map "\C-c\C-q" 'erlang-indent-function) + (define-key map "\C-c\C-u" 'erlang-uncomment-region) + (define-key map "\C-c\C-y" 'erlang-clone-arguments) + (define-key map "\C-c\C-a" 'erlang-align-arrows) + (define-key map "\C-c\C-z" 'erlang-shell-display) + (unless inferior-erlang-use-cmm + (define-key map "\C-x`" 'erlang-next-error))) + + +(defun erlang-electric-init () + ;; Set up electric character functions to work with + ;; delsel/pending-del mode. Also, set up text properties for bit + ;; syntax handling. + (mapc #'(lambda (cmd) + (put cmd 'delete-selection t) ;for delsel (Emacs) + (put cmd 'pending-delete t)) ;for pending-del (XEmacs) + '(erlang-electric-semicolon + erlang-electric-comma + erlang-electric-gt)) + + (put 'bitsyntax-open-outer 'syntax-table '(4 . ?>)) + (put 'bitsyntax-open-outer 'rear-nonsticky '(category)) + (put 'bitsyntax-open-inner 'rear-nonsticky '(category)) + (put 'bitsyntax-close-inner 'rear-nonsticky '(category)) + (put 'bitsyntax-close-outer 'syntax-table '(5 . ?<)) + (put 'bitsyntax-close-outer 'rear-nonsticky '(category)) + (make-local-variable 'parse-sexp-lookup-properties) + (setq parse-sexp-lookup-properties 't)) + + +(defun erlang-mode-variables () + (or erlang-mode-abbrev-table + (define-abbrev-table 'erlang-mode-abbrev-table ())) + (setq local-abbrev-table erlang-mode-abbrev-table) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t) + (make-local-variable 'require-final-newline) + (setq require-final-newline t) + (make-local-variable 'defun-prompt-regexp) + (setq defun-prompt-regexp erlang-defun-prompt-regexp) + (make-local-variable 'comment-start) + (setq comment-start "%") + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "%+\\s *") + (make-local-variable 'comment-column) + (setq comment-column 48) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'erlang-indent-command) + (make-local-variable 'indent-region-function) + (setq indent-region-function 'erlang-indent-region) + (set (make-local-variable 'comment-indent-function) 'erlang-comment-indent) + (if (<= erlang-emacs-major-version 18) + (set (make-local-variable 'comment-indent-hook) 'erlang-comment-indent)) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'dabbrev-case-fold-search) nil) + (set (make-local-variable 'imenu-prev-index-position-function) + 'erlang-beginning-of-function) + (set (make-local-variable 'imenu-extract-index-name-function) + 'erlang-get-function-name) + (set (make-local-variable 'tempo-match-finder) + "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=") + (set (make-local-variable 'beginning-of-defun-function) + 'erlang-beginning-of-function) + (set (make-local-variable 'end-of-defun-function) 'erlang-end-of-function) + (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil) + (set (make-local-variable 'fill-paragraph-function) 'erlang-fill-paragraph) + (set (make-local-variable 'comment-add) 1) + (set (make-local-variable 'outline-regexp) "[[:lower:]0-9_]+ *(.*) *-> *$") + (set (make-local-variable 'outline-level) (lambda () 1)) + (set (make-local-variable 'add-log-current-defun-function) + 'erlang-current-defun)) + + +;; Compilation. +;; +;; The following code is compatible with the standard package `compilation', +;; making it possible to go to errors using `erlang-next-error' (or just +;; `next-error' in Emacs 21). +;; +;; The normal `compile' command works of course. For best result, please +;; execute `make' with the `-w' flag. +;; +;; Please see the variables named `compiling-..' above. + +(defun erlang-add-compilation-alist (alist) + (require 'compile) + (cond ((boundp 'compilation-error-regexp-alist) ; Emacs 19 + (while alist + (or (assoc (car (car alist)) compilation-error-regexp-alist) + (setq compilation-error-regexp-alist + (cons (car alist) compilation-error-regexp-alist))) + (setq alist (cdr alist)))) + ((boundp 'compilation-error-regexp) + ;; Emacs 18, Only one regexp is allowed. + (funcall (symbol-function 'set) + 'compilation-error-regexp (car (car alist)))))) + +(defun erlang-font-lock-init () + "Initialize Font Lock for Erlang mode." + (or erlang-font-lock-syntax-table + (setq erlang-font-lock-syntax-table + (let ((table (copy-syntax-table erlang-mode-syntax-table))) + (modify-syntax-entry ?_ "w" table) + table))) + (set (make-local-variable 'font-lock-syntax-table) + erlang-font-lock-syntax-table) + (set (make-local-variable 'font-lock-beginning-of-syntax-function) + 'erlang-beginning-of-clause) + (make-local-variable 'font-lock-keywords) + (let ((level (cond ((boundp 'font-lock-maximum-decoration) + (symbol-value 'font-lock-maximum-decoration)) + ((boundp 'font-lock-use-maximal-decoration) + (symbol-value 'font-lock-use-maximal-decoration)) + (t nil)))) + (if (consp level) + (setq level (cdr-safe (or (assq 'erlang-mode level) + (assq t level))))) + ;; `level' can here be: + ;; A number - The fontification level + ;; nil - Use the default + ;; t - Use maximum + (cond ((eq level nil) + (set 'font-lock-keywords erlang-font-lock-keywords)) + ((eq level 1) + (set 'font-lock-keywords erlang-font-lock-keywords-1)) + ((eq level 2) + (set 'font-lock-keywords erlang-font-lock-keywords-2)) + ((eq level 3) + (set 'font-lock-keywords erlang-font-lock-keywords-3)) + (t + (set 'font-lock-keywords erlang-font-lock-keywords-4)))) + + ;; Modern font-locks can handle the above much more elegantly: + (set (make-local-variable 'font-lock-defaults) + '((erlang-font-lock-keywords erlang-font-lock-keywords-1 + erlang-font-lock-keywords-2 + erlang-font-lock-keywords-3 + erlang-font-lock-keywords-4) + nil nil ((?_ . "w")) erlang-beginning-of-clause + (font-lock-mark-block-function . erlang-mark-clause)))) + + + +;; Useful when defining your own keywords. +(defun erlang-font-lock-set-face (ks &rest faces) + "Replace the face components in a list of keywords. + +The first argument, KS, is a list of keywords. The rest of the +arguments are expressions to replace the face information with. The +first expression replaces the face of the first keyword, the second +expression the second keyword etc. + +Should an expression be nil, the face of the corresponding keyword is +not changed. + +Should fewer expressions than keywords be given, the last expression +is used for all remaining keywords. + +Normally, the expressions are just atoms representing the new face. +They could however be more complex, returning different faces in +different situations. + +This function only handles keywords with elements on the forms: + (REGEXP NUMBER FACE) + (REGEXP NUMBER FACE OVERWRITE) + +This could be used when defining your own special font-lock setup, e.g: + +\(setq my-font-lock-keywords + (append erlang-font-lock-keywords-function-header + erlang-font-lock-keywords-dollar + (erlang-font-lock-set-face + erlang-font-lock-keywords-macros 'my-neon-green-face) + (erlang-font-lock-set-face + erlang-font-lock-keywords-lc 'my-deep-red 'my-light-red) + erlang-font-lock-keywords-attr)) + +For a more elaborate example, please see the beginning of the file +`erlang.el'." + (let ((res '())) + (while ks + (let* ((regexp (car (car ks))) + (number (car (cdr (car ks)))) + (new-face (if (and faces (car faces)) + (car faces) + (car (cdr (cdr (car ks)))))) + (overwrite (car (cdr (cdr (cdr (car ks)))))) + (new-keyword (list regexp number new-face))) + (if overwrite (nconc new-keyword (list overwrite))) + (setq res (cons new-keyword res)) + (setq ks (cdr ks)) + (if (and faces (cdr faces)) + (setq faces (cdr faces))))) + (nreverse res))) + + +(defun erlang-font-lock-level-0 () + ;; DocStringOrig: font-cmd + "Unfontify current buffer." + (interactive) + (font-lock-mode 0)) + + +(defun erlang-font-lock-level-1 () + ;; DocStringCopy: font-cmd + "Fontify current buffer at level 1. +This highlights function headers, reserved keywords, strings and comments." + (interactive) + (require 'font-lock) + (set 'font-lock-keywords erlang-font-lock-keywords-1) + (font-lock-mode 1) + (funcall (symbol-function 'font-lock-fontify-buffer))) + + +(defun erlang-font-lock-level-2 () + ;; DocStringCopy: font-cmd + "Fontify current buffer at level 2. +This highlights level 1 features (see `erlang-font-lock-level-1') +plus bifs, guards and `single quotes'." + (interactive) + (require 'font-lock) + (set 'font-lock-keywords erlang-font-lock-keywords-2) + (font-lock-mode 1) + (funcall (symbol-function 'font-lock-fontify-buffer))) + + +(defun erlang-font-lock-level-3 () + ;; DocStringCopy: font-cmd + "Fontify current buffer at level 3. +This highlights level 2 features (see `erlang-font-lock-level-2') +plus variables, macros and records." + (interactive) + (require 'font-lock) + (set 'font-lock-keywords erlang-font-lock-keywords-3) + (font-lock-mode 1) + (funcall (symbol-function 'font-lock-fontify-buffer))) + +(defun erlang-font-lock-level-4 () + ;; DocStringCopy: font-cmd + "Fontify current buffer at level 4. +This highlights level 3 features (see `erlang-font-lock-level-2') +plus variables, macros and records." + (interactive) + (require 'font-lock) + (set 'font-lock-keywords erlang-font-lock-keywords-4) + (font-lock-mode 1) + (funcall (symbol-function 'font-lock-fontify-buffer))) + + +(defun erlang-menu-init () + "Init menus for Erlang mode. + +The variable `erlang-menu-items' contain a description of the Erlang +mode menu. Normally, the list contains atoms, representing variables +bound to pieces of the menu. + +Personal extensions could be added to `erlang-menu-personal-items'. + +This function should be called if any variable describing the +menu configuration is changed." + (erlang-menu-install "Erlang" erlang-menu-items erlang-mode-map t)) + + +(defun erlang-menu-install (name items keymap &optional popup) + "Install a menu in Emacs or XEmacs based on an abstract description. + +NAME is the name of the menu. + +ITEMS is a list. The elements are either nil representing a horizontal +line or a list with two or three elements. The first is the name of +the menu item, the second the function to call, or a submenu, on the +same same form as ITEMS. The third optional element is an expression +which is evaluated every time the menu is displayed. Should the +expression evaluate to nil the menu item is ghosted. + +KEYMAP is the keymap to add to menu to. (When using XEmacs, the menu +will only be visible when this menu is the global, the local, or an +activate minor mode keymap.) + +If POPUP is non-nil, the menu is bound to the XEmacs `mode-popup-menu' +variable, i.e. it will popup when pressing the right mouse button. + +Please see the variable `erlang-menu-base-items'." + (cond (erlang-xemacs-p + (let ((menu (erlang-menu-xemacs name items keymap))) + ;; We add the menu to the global menubar. + ;;(funcall (symbol-function 'set-buffer-menubar) + ;; (symbol-value 'current-menubar)) + (funcall (symbol-function 'add-submenu) nil menu) + (setcdr erlang-xemacs-popup-menu (cdr menu)) + (if (and popup (boundp 'mode-popup-menu)) + (funcall (symbol-function 'set) + 'mode-popup-menu erlang-xemacs-popup-menu)))) + ((>= erlang-emacs-major-version 19) + (define-key keymap (vector 'menu-bar (intern name)) + (erlang-menu-make-keymap name items))) + (t nil))) + + +(defun erlang-menu-make-keymap (name items) + "Build a menu for Emacs 19." + (let ((menumap (funcall (symbol-function 'make-sparse-keymap) + name)) + (count 0) + id def first second third) + (setq items (reverse items)) + (while items + ;; Replace any occurrence of atoms by their value. + (while (and items (atom (car items)) (not (null (car items)))) + (if (and (boundp (car items)) + (listp (symbol-value (car items)))) + (setq items (append (reverse (symbol-value (car items))) + (cdr items))) + (setq items (cdr items)))) + (setq first (car-safe (car items))) + (setq second (car-safe (cdr-safe (car items)))) + (setq third (car-safe (cdr-safe (cdr-safe (car items))))) + (cond ((null first) + (setq count (+ count 1)) + (setq id (intern (format "separator-%d" count))) + (setq def '("--" . nil))) + ((and (consp second) (eq (car second) 'lambda)) + (setq count (+ count 1)) + (setq id (intern (format "lambda-%d" count))) + (setq def (cons first second))) + ((symbolp second) + (setq id second) + (setq def (cons first second))) + (t + (setq count (+ count 1)) + (setq id (intern (format "submenu-%d" count))) + (setq def (erlang-menu-make-keymap first second)))) + (define-key menumap (vector id) def) + (if third + (put id 'menu-enable third)) + (setq items (cdr items))) + (cons name menumap))) + + +(defun erlang-menu-xemacs (name items &optional keymap) + "Build a menu for XEmacs." + (let ((res '()) + first second third entry) + (while items + ;; Replace any occurrence of atoms by their value. + (while (and items (atom (car items)) (not (null (car items)))) + (if (and (boundp (car items)) + (listp (symbol-value (car items)))) + (setq items (append (reverse (symbol-value (car items))) + (cdr items))) + (setq items (cdr items)))) + (setq first (car-safe (car items))) + (setq second (car-safe (cdr-safe (car items)))) + (setq third (car-safe (cdr-safe (cdr-safe (car items))))) + (cond ((null first) + (setq res (cons "------" res))) + ((symbolp second) + (setq res (cons (vector first second (or third t)) res))) + ((and (consp second) (eq (car second) 'lambda)) + (setq res (cons (vector first (list 'call-interactively second) + (or third t)) res))) + (t + (setq res (cons (cons first + (cdr (erlang-menu-xemacs + first second))) + res)))) + (setq items (cdr items))) + (setq res (reverse res)) + ;; When adding a menu to a minor-mode keymap under Emacs, + ;; it disappears when the mode is disabled. The expression + ;; generated below imitates this behaviour. + ;; (This could be expressed much clearer using backquotes, + ;; but I don't want to pull in every package.) + (if keymap + (let ((expr (list 'or + (list 'eq keymap 'global-map) + (list 'eq keymap (list 'current-local-map)) + (list 'symbol-value + (list 'car-safe + (list 'rassq + keymap + 'minor-mode-map-alist)))))) + (setq res (cons ':included (cons expr res))))) + (cons name res))) + + +(defun erlang-menu-substitute (items alist) + "Substitute functions in menu described by ITEMS. + +The menu ITEMS is updated destructively. + +ALIST is list of pairs where the car is the old function and cdr the new." + (let (first second pair) + (while items + (setq first (car-safe (car items))) + (setq second (car-safe (cdr-safe (car items)))) + (cond ((null first)) + ((symbolp second) + (setq pair (and second (assq second alist))) + (if pair + (setcar (cdr (car items)) (cdr pair)))) + ((and (consp second) (eq (car second) 'lambda))) + (t + (erlang-menu-substitute second alist))) + (setq items (cdr items))))) + + +(defun erlang-menu-add-above (entry above items) + "Add menu ENTRY above menu entry ABOVE in menu ITEMS. +Do nothing if the items already should be in the menu. +Should ABOVE not be in the list, the entry is added at +the bottom of the menu. + +The new menu is returned. No guarantee is given that the original +menu is left unchanged. + +The equality test is performed by `eq'. + +Example: (erlang-menu-add-above 'my-erlang-menu-items + 'erlang-menu-man-items)" + (erlang-menu-add-below entry above items t)) + + +(defun erlang-menu-add-below (entry below items &optional above-p) + "Add menu ENTRY below menu items BELOW in the Erlang menu. +Do nothing if the items already should be in the menu. +Should BELOW not be in the list, items is added at the bottom +of the menu. + +The new menu is returned. No guarantee is given that the original +menu is left unchanged. + +The equality test is performed by `eq'. + +Example: + +\(setq erlang-menu-items + (erlang-menu-add-below 'my-erlang-menu-items + 'erlang-menu-base-items + erlang-menu-items))" + (if (memq entry items) + items ; Return the original menu. + (let ((head '()) + (done nil) + res) + (while (not done) + (cond ((null items) + (setq res (append head (list entry))) + (setq done t)) + ((eq below (car items)) + (setq res + (if above-p + (append head (cons entry items)) + (append head (cons (car items) + (cons entry (cdr items)))))) + (setq done t)) + (t + (setq head (append head (list (car items)))) + (setq items (cdr items))))) + res))) + +(defun erlang-menu-delete (entry items) + "Delete ENTRY from menu ITEMS. + +The new menu is returned. No guarantee is given that the original +menu is left unchanged." + (delq entry items)) + +;; Man code: + +(defun erlang-man-init () + "Add menus containing the manual pages of the Erlang. + +The variable `erlang-man-dirs' contains entries describing +the location of the manual pages." + (interactive) + (if erlang-man-inhibit + () + (setq erlang-menu-man-items + '(nil + ("Man - Function" erlang-man-function))) + (if erlang-man-dirs + (setq erlang-menu-man-items + (append erlang-menu-man-items + (erlang-man-make-top-menu erlang-man-dirs)))) + (setq erlang-menu-items + (erlang-menu-add-above 'erlang-menu-man-items + 'erlang-menu-version-items + erlang-menu-items)) + (erlang-menu-init))) + + +(defun erlang-man-uninstall () + "Remove the man pages from the Erlang mode." + (interactive) + (setq erlang-menu-items + (erlang-menu-delete 'erlang-menu-man-items erlang-menu-items)) + (erlang-menu-init)) + + +;; The man menu is a hierarchal structure, with the manual sections +;; at the top, described by `erlang-man-dirs'. The next level could +;; either be the manual pages if not to many, otherwise it is an index +;; menu whose submenus will contain up to `erlang-man-max-menu-size' +;; manual pages. + +(defun erlang-man-make-top-menu (dir-list) + "Create one menu entry per element of DIR-LIST. +The format is described in the documentation of `erlang-man-dirs'." + (let ((menu '()) + dir) + (while dir-list + (setq dir (cond ((nth 2 (car dir-list)) + ;; Relative to `erlang-root-dir'. + (and (stringp erlang-root-dir) + (concat erlang-root-dir (nth 1 (car dir-list))))) + (t + ;; Absolute + (nth 1 (car dir-list))))) + (if (and dir + (file-readable-p dir)) + (setq menu (cons (list (car (car dir-list)) + (erlang-man-make-middle-menu + (erlang-man-get-files dir))) + menu))) + (setq dir-list (cdr dir-list))) + ;; Should no menus be found, generate a menu item which + ;; will display a help text, when selected. + (if menu + (nreverse menu) + '(("Man Pages" + (("Error! Why?" erlang-man-describe-error))))))) + + +;; Should the menu be to long, let's split it into a number of +;; smaller menus. Warning, this code contains beautiful +;; destructive operations! +(defun erlang-man-make-middle-menu (filelist) + "Create the second level menu from FILELIST. + +Should the list be longer than `erlang-man-max-menu-size', a tree of +menus is created." + (if (<= (length filelist) erlang-man-max-menu-size) + (erlang-man-make-menu filelist) + (let ((menu '()) + (filelist (copy-sequence filelist)) + segment submenu pair) + (while filelist + (setq pair (nthcdr (- erlang-man-max-menu-size 1) filelist)) + (setq segment filelist) + (if (null pair) + (setq filelist nil) + (setq filelist (cdr pair)) + (setcdr pair nil)) + (setq submenu (erlang-man-make-menu segment)) + (setq menu (cons (list (concat (car (car submenu)) + " -- " + (car (car (reverse submenu)))) + submenu) + menu))) + (nreverse menu)))) + + +(defun erlang-man-make-menu (filelist) + "Make a leaf menu based on FILELIST." + (let ((menu '()) + item) + (while filelist + (setq item (erlang-man-make-menu-item (car filelist))) + (if item + (setq menu (cons item menu))) + (setq filelist (cdr filelist))) + (nreverse menu))) + + +(defun erlang-man-make-menu-item (file) + "Create a menu item containing the name of the man page." + (and (string-match ".+/\\([^/]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$" file) + (let ((page (substring file (match-beginning 1) (match-end 1)))) + (list (capitalize page) + (list 'lambda '() + '(interactive) + (list 'funcall 'erlang-man-display-function + file)))))) + + +(defun erlang-man-get-files (dir) + "Return files in directory DIR." + (directory-files dir t ".+\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?\\'")) + + +(defun erlang-man-module (&optional module) + "Find manual page for MODULE, defaults to module of function under point. +This function is aware of imported functions." + (interactive + (list (let* ((mod (car-safe (erlang-get-function-under-point))) + (input (read-string + (format "Manual entry for module%s: " + (if (or (null mod) (string= mod "")) + "" + (format " (default %s)" mod)))))) + (if (string= input "") + mod + input)))) + (or module (setq module (car (erlang-get-function-under-point)))) + (if (or (null module) (string= module "")) + (error "No Erlang module name given")) + (let ((dir-list erlang-man-dirs) + (pat (concat "/" (regexp-quote module) "\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$")) + (file nil) + file-list) + (while (and dir-list (null file)) + (setq file-list (erlang-man-get-files + (if (nth 2 (car dir-list)) + (concat erlang-root-dir (nth 1 (car dir-list))) + (nth 1 (car dir-list))))) + (while (and file-list (null file)) + (if (string-match pat (car file-list)) + (setq file (car file-list))) + (setq file-list (cdr file-list))) + (setq dir-list (cdr dir-list))) + (if file + (funcall erlang-man-display-function file) + (error "No manual page for module %s found" module)))) + + +;; Warning, the function `erlang-man-function' is a hack! +;; It links itself into the man code in a non-clean way. I have +;; chosen to keep it since it provides a very useful functionality +;; which is not possible to achieve using a clean approach. +;; / AndersL + +(defvar erlang-man-function-name nil + "Name of function for last `erlang-man-function' call. +Used for communication between `erlang-man-function' and the +patch to `Man-notify-when-ready'.") + +(defun erlang-man-function (&optional name) + "Find manual page for NAME, where NAME is module:function. +The entry for `function' is displayed. + +This function is aware of imported functions." + (interactive + (list (let* ((mod-func (erlang-get-function-under-point)) + (mod (car-safe mod-func)) + (func (nth 1 mod-func)) + (input (read-string + (format + "Manual entry for `module:func' or `module'%s: " + (if (or (null mod) (string= mod "")) + "" + (format " (default %s:%s)" mod func)))))) + (if (string= input "") + (if (and mod func) + (concat mod ":" func) + mod) + input)))) + ;; Emacs 18 doesn't provide `man'... + (condition-case nil + (require 'man) + (error nil)) + (let ((modname nil) + (funcname nil)) + (cond ((null name) + (let ((mod-func (erlang-get-function-under-point))) + (setq modname (car-safe mod-func)) + (setq funcname (nth 1 mod-func)))) + ((string-match ":" name) + (setq modname (substring name 0 (match-beginning 0))) + (setq funcname (substring name (match-end 0) nil))) + ((stringp name) + (setq modname name))) + (if (or (null modname) (string= modname "")) + (error "No Erlang module name given")) + (cond ((fboundp 'Man-notify-when-ready) + ;; Emacs 19: The man command could possibly start an + ;; asynchronous process, i.e. we must hook ourselves into + ;; the system to be activated when the man-process + ;; terminates. + (if (null funcname) + () + (erlang-man-patch-notify) + (setq erlang-man-function-name funcname)) + (condition-case nil + (erlang-man-module modname) + (error (setq erlang-man-function-name nil)))) + (t + (erlang-man-module modname) + (if funcname + (erlang-man-find-function + (or (get-buffer "*Manual Entry*") ; Emacs 18 + (current-buffer)) ; XEmacs + funcname)))))) + + +;; Should the defadvice be at the top level, the package `advice' would +;; be required. Now it is only required when this functionality +;; is used. (Emacs 19 specific.) +(defun erlang-man-patch-notify () + "Patch the function `Man-notify-when-ready' to search for function. +The variable `erlang-man-function-name' is assumed to be bound to +the function name, or to nil. + +The reason for patching a function is that under Emacs 19, the man +command is executed asynchronously." + (condition-case nil + (require 'advice) + ;; This should never happened since this is only called when + ;; running under Emacs 19. + (error (error (concat "This command needs the package `advice', " + "please upgrade your Emacs.")))) + (require 'man) + (defadvice Man-notify-when-ready + (after erlang-Man-notify-when-ready activate) + "Set point at the documentation of the function name in +`erlang-man-function-name' when the man page is displayed." + (if erlang-man-function-name + (erlang-man-find-function (ad-get-arg 0) erlang-man-function-name)) + (setq erlang-man-function-name nil))) + + +(defun erlang-man-find-function (buf func) + "Find manual page for function in `erlang-man-function-name' in buffer BUF." + (if func + (let ((win (get-buffer-window buf))) + (if win + (progn + (set-buffer buf) + (goto-char (point-min)) + (if (re-search-forward + (concat "^[ \t]+" func " ?(") + (point-max) t) + (progn + (forward-word -1) + (set-window-point win (point))) + (message "Could not find function `%s'" func))))))) + + +(defun erlang-man-display (file) + "Display FILE as a `man' file. +This is the default manual page display function. +The variables `erlang-man-display-function' contains the function +to be used." + ;; Emacs 18 doesn't `provide' man. + (condition-case nil + (require 'man) + (error nil)) + (if file + (let ((process-environment (copy-sequence process-environment))) + (if (string-match "\\(.*\\)/man[^/]*/\\([^.]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$" file) + (let ((dir (substring file (match-beginning 1) (match-end 1))) + (page (substring file (match-beginning 2) (match-end 2)))) + (if (fboundp 'setenv) + (setenv "MANPATH" dir) + ;; Emacs 18 + (setq process-environment (cons (concat "MANPATH=" dir) + process-environment))) + (cond ((not (and (not erlang-xemacs-p) + (= erlang-emacs-major-version 19) + (< erlang-emacs-minor-version 29))) + (manual-entry page)) + (t + ;; Emacs 19.28 and earlier versions of 19: + ;; The manual-entry command unconditionally prompts + ;; the user :-( + (funcall (symbol-function 'Man-getpage-in-background) + page)))) + (error "Can't find man page for %s\n" file))))) + + +(defun erlang-man-describe-error () + "Describe why the manual pages weren't found." + (interactive) + (with-output-to-temp-buffer "*Erlang Man Error*" + (princ "Normally, this menu should contain Erlang manual pages. + +In order to find the manual pages, the variable `erlang-root-dir' +should be bound to the name of the directory containing the Erlang +installation. The name should not include the final slash. + +Practically, you should add a line on the following form to +your ~/.emacs, or ask your system administrator to add it to +the site init file: + (setq erlang-root-dir \"/the/erlang/root/dir/goes/here\") + +For example: + (setq erlang-root-dir \"/usr/local/erlang\") + +After installing the line, kill and restart Emacs, or restart Erlang +mode with the command `M-x erlang-mode RET'."))) + +;; Skeleton code: + +;; This code is based on the package `tempo' which is part of modern +;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.) + +(defun erlang-skel-init () + "Generate the skeleton functions and menu items. +The variable `erlang-skel' contains the name and descriptions of +all skeletons. + +The skeleton routines are based on the `tempo' package. Should this +package not be present, this function does nothing." + (interactive) + (condition-case nil + (require 'tempo) + (error t)) + (if (featurep 'tempo) + (let ((skel erlang-skel) + (menu '())) + (while skel + (cond ((null (car skel)) + (setq menu (cons nil menu))) + (t + (funcall (symbol-function 'tempo-define-template) + (concat "erlang-" (nth 1 (car skel))) + ;; The tempo template used contains an `include' + ;; function call only, hence changes to the + ;; variables describing the templates take effect + ;; immdiately. + (list (list 'erlang-skel-include (nth 2 (car skel)))) + (nth 1 (car skel)) + (car (car skel)) + 'erlang-tempo-tags) + (setq menu (cons (erlang-skel-make-menu-item + (car skel)) menu)))) + (setq skel (cdr skel))) + (setq erlang-menu-skel-items + (list nil (list "Skeletons" (nreverse menu)))) + (setq erlang-menu-items + (erlang-menu-add-above 'erlang-menu-skel-items + 'erlang-menu-version-items + erlang-menu-items)) + (erlang-menu-init)))) + +(defun erlang-skel-make-menu-item (skel) + (let ((func (intern (concat "tempo-template-erlang-" (nth 1 skel))))) + (cond ((null (nth 3 skel)) + (list (car skel) func)) + (t + (list (car skel) + (list 'lambda '() + '(interactive) + (list 'funcall + (list 'quote (nth 3 skel)) + (list 'quote func)))))))) + +;; Functions designed to be added to the skeleton menu. +;; (Not normally used) +(defun erlang-skel-insert (func) + "Insert skeleton generated by FUNC and goto first tempo mark." + (save-excursion (funcall func)) + (funcall (symbol-function 'tempo-forward-mark))) + +(defun erlang-skel-header (func) + "Insert the header generated by FUNC at the beginning of the buffer." + (goto-char (point-min)) + (save-excursion (funcall func)) + (funcall (symbol-function 'tempo-forward-mark))) + + +;; Functions used inside the skeleton descriptions. +(defun erlang-skel-skip-blank () + (skip-chars-backward " \t") + nil) + +(defun erlang-skel-include (&rest args) + "Include a template inside another template. + +Example of use, assuming that `erlang-skel-func' is defined: + + (defvar foo-skeleton '(\"%%% New function:\" + (erlang-skel-include erlang-skel-func))) + +Technically, this function returns the `tempo' attribute`(l ...)' which +can contain other `tempo' attributes. Please see the function +`tempo-define-template' for a description of the `(l ...)' attribute." + (let ((res '()) + entry) + (while args + (setq entry (car args)) + (while entry + (setq res (cons (car entry) res)) + (setq entry (cdr entry))) + (setq args (cdr args))) + (cons 'l (nreverse res)))) + +(defvar erlang-skel-separator-length 70) + +(defun erlang-skel-separator (&optional percent) + "Return a comment separator." + (let ((percent (or percent 3))) + (concat (make-string percent ?%) + (make-string (- erlang-skel-separator-length percent) ?-) + "\n"))) + +(defun erlang-skel-double-separator (&optional percent) + "Return a comment separator." + (let ((percent (or percent 3))) + (concat (make-string percent ?%) + (make-string (- erlang-skel-separator-length percent) ?=) + "\n"))) + +(defun erlang-skel-dd-mmm-yyyy () + "Return the current date as a string in \"DD Mon YYYY\" form. +The first character of DD is space if the value is less than 10." + (let ((date (current-time-string))) + (format "%2d %s %s" + (erlang-string-to-int (substring date 8 10)) + (substring date 4 7) + (substring date -4)))) + +;; Indentation code: + +(defun erlang-indent-command (&optional whole-exp) + "Indent current line as Erlang code. +With argument, indent any additional lines of the same clause +rigidly along with this one." + (interactive "P") + (if whole-exp + ;; If arg, always indent this line as Erlang + ;; and shift remaining lines of clause the same amount. + (let ((shift-amt (erlang-indent-line)) + beg end) + (save-excursion + (if erlang-tab-always-indent + (beginning-of-line)) + (setq beg (point)) + (erlang-end-of-clause 1) + (setq end (point)) + (goto-char beg) + (forward-line 1) + (setq beg (point))) + (if (> end beg) + (indent-code-rigidly beg end shift-amt "\n"))) + (if (and (not erlang-tab-always-indent) + (save-excursion + (skip-chars-backward " \t") + (not (bolp)))) + (insert-tab) + (erlang-indent-line)))) + + +(defun erlang-indent-line () + "Indent current line as Erlang code. +Return the amount the indentation changed by." + (let ((pos (- (point-max) (point))) + indent beg + shift-amt) + (beginning-of-line 1) + (setq beg (point)) + (skip-chars-forward " \t") + (cond ((looking-at "%") + (setq indent (funcall comment-indent-function)) + (setq shift-amt (- indent (current-column)))) + (t + (setq indent (erlang-calculate-indent)) + (cond ((null indent) + (setq indent (current-indentation))) + ((eq indent t) + ;; This should never occur here. + (error "Erlang mode error")) + ;;((= (char-syntax (following-char)) ?\)) + ;; (setq indent (1- indent))) + ) + (setq shift-amt (- indent (current-column))))) + (if (zerop shift-amt) + nil + (delete-region beg (point)) + (indent-to indent)) + ;; If initial point was within line's indentation, position + ;; after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + shift-amt)) + + +(defun erlang-indent-region (beg end) + "Indent region of Erlang code. + +This is automagically called by the user level function `indent-region'." + (interactive "r") + (save-excursion + (let ((case-fold-search nil) + (continue t) + (from-end (- (point-max) end)) + indent-point;; The beginning of the current line + indent;; The indent amount + state) + (goto-char beg) + (beginning-of-line) + (setq indent-point (point)) + (erlang-beginning-of-clause) + ;; Parse the Erlang code from the beginning of the clause to + ;; the beginning of the region. + (while (< (point) indent-point) + (setq state (erlang-partial-parse (point) indent-point state))) + ;; Indent every line in the region + (while continue + (goto-char indent-point) + (skip-chars-forward " \t") + (cond ((looking-at "%") + ;; Do not use our stack to help the user to customize + ;; comment indentation. + (setq indent (funcall comment-indent-function))) + ((looking-at "$") + ;; Don't indent empty lines. + (setq indent 0)) + (t + (setq indent + (save-excursion + (erlang-calculate-stack-indent (point) state))) + (cond ((null indent) + (setq indent (current-indentation))) + ((eq indent t) + ;; This should never occur here. + (error "Erlang mode error")) + ;;((= (char-syntax (following-char)) ?\)) + ;; (setq indent (1- indent))) + ))) + (if (zerop (- indent (current-column))) + nil + (delete-region indent-point (point)) + (indent-to indent)) + ;; Find the next line in the region + (goto-char indent-point) + (save-excursion + (forward-line 1) + (setq indent-point (point))) + (if (>= from-end (- (point-max) indent-point)) + (setq continue nil) + (while (< (point) indent-point) + (setq state (erlang-partial-parse + (point) indent-point state)))))))) + + +(defun erlang-indent-current-buffer () + "Indent current buffer as Erlang code." + (interactive) + (save-excursion + (save-restriction + (widen) + (erlang-indent-region (point-min) (point-max))))) + + +(defun erlang-indent-function () + "Indent current Erlang function." + (interactive) + (save-excursion + (let ((end (progn (erlang-end-of-function 1) (point))) + (beg (progn (erlang-beginning-of-function 1) (point)))) + (erlang-indent-region beg end)))) + + +(defun erlang-indent-clause () + "Indent current Erlang clause." + (interactive) + (save-excursion + (let ((end (progn (erlang-end-of-clause 1) (point))) + (beg (progn (erlang-beginning-of-clause 1) (point)))) + (erlang-indent-region beg end)))) + + +(defmacro erlang-push (x stack) (list 'setq stack (list 'cons x stack))) +(defmacro erlang-pop (stack) (list 'setq stack (list 'cdr stack))) +;; Would much prefer to make caddr a macro but this clashes. +(defun erlang-caddr (x) (car (cdr (cdr x)))) + + +(defun erlang-calculate-indent (&optional parse-start) + "Compute appropriate indentation for current line as Erlang code. +Return nil if line starts inside string, t if in a comment." + (save-excursion + (let ((indent-point (point)) + (case-fold-search nil) + (state nil)) + (if parse-start + (goto-char parse-start) + (erlang-beginning-of-clause)) + (while (< (point) indent-point) + (setq state (erlang-partial-parse (point) indent-point state))) + (erlang-calculate-stack-indent indent-point state)))) + +(defun erlang-show-syntactic-information () + "Show syntactic information for current line." + + (interactive) + + (save-excursion + (let ((starting-point (point)) + (case-fold-search nil) + (state nil)) + (erlang-beginning-of-clause) + (while (< (point) starting-point) + (setq state (erlang-partial-parse (point) starting-point state))) + (message "%S" state)))) + + +(defun erlang-partial-parse (from to &optional state) + "Parse Erlang syntax starting at FROM until TO, with an optional STATE. +Value is list (stack token-start token-type in-what)." + (goto-char from) ; Start at the beginning + (erlang-skip-blank to) + (let ((cs (char-syntax (following-char))) + (stack (car state)) + (token (point)) + in-what) + (cond + + ;; Done: Return previous state. + ((>= token to) + (setq token (nth 1 state)) + (setq cs (nth 2 state)) + (setq in-what (nth 3 state))) + + ;; Word constituent: check and handle keywords. + ((= cs ?w) + (cond ((looking-at "\\(end\\|after\\)[^_a-zA-Z0-9]") + ;; Must pop top icr layer, `after' will push a new + ;; layer next. + (progn + (while (and stack (eq (car (car stack)) '->)) + (erlang-pop stack)) + (if (and stack (memq (car (car stack)) '(icr begin fun try))) + (erlang-pop stack)))) + ((looking-at "catch.*of") + t) + ((looking-at "catch\\s *\\($\\|%\\|.*->\\)") + ;; Must pop top icr layer, `catch' in try/catch + ;;will push a new layer next. + (progn + (while (and stack (eq (car (car stack)) '->)) + (erlang-pop stack)) + (if (and stack (memq (car (car stack)) '(icr begin try))) + (erlang-pop stack)))) + ) + (cond ((looking-at "\\(if\\|case\\|receive\\)[^_a-zA-Z0-9]") + ;; Must push a new icr (if/case/receive) layer. + (erlang-push (list 'icr token (current-column)) stack)) + ((looking-at "\\(try\\|after\\)[^_a-zA-Z0-9]") + ;; Must handle separately, try catch or try X of -> catch + ;; same for `after', it could be + ;; receive after Time -> X end, or + ;; try after X end + (erlang-push (list 'try token (current-column)) stack)) + ((looking-at "\\(of\\)[^_a-zA-Z0-9]") + ;; Must handle separately, try X of -> catch + (if (and stack (eq (car (car stack)) 'try)) + (let ((try-column (nth 2 (car stack)))) + (erlang-pop stack) + (erlang-push (list 'icr token try-column) stack)))) + + ((looking-at "\\(fun\\)[^_a-zA-Z0-9]") + ;; Push a new layer if we are defining a `fun' + ;; expression, not when we are refering an existing + ;; function. 'fun's defines are only indented one level now. + (if (save-excursion + (goto-char (match-end 1)) + (erlang-skip-blank to) + (eq (following-char) ?\()) + (erlang-push (list 'fun token (current-column)) stack))) + ((looking-at "\\(begin\\|query\\)[^_a-zA-Z0-9]") + (erlang-push (list 'begin token (current-column)) stack)) + ;; Normal when case + ;;((looking-at "when\\s ") + ;;((looking-at "when\\s *\\($\\|%\\)") + ((looking-at "when[^_a-zA-Z0-9]") + (erlang-push (list 'when token (current-column)) stack)) + ((looking-at "catch.*of") + t) + ((looking-at "catch\\s *\\($\\|%\\|.*->\\)") + (erlang-push (list 'icr token (current-column)) stack)) + ;;(erlang-push (list '-> token (current-column)) stack)) + ;;((looking-at "^of$") + ;; (erlang-push (list 'icr token (current-column)) stack) + ;;(erlang-push (list '-> token (current-column)) stack)) + ) + (forward-sexp 1)) + ;; String: Try to skip over it. (Catch error if not complete.) + ((= cs ?\") + (condition-case nil + (progn + (forward-sexp 1) + (if (> (point) to) + (progn + (setq in-what 'string) + (goto-char to)))) + (error + (setq in-what 'string) + (goto-char to)))) + + ;; Expression prefix e.i. $ or ^ (Note ^ can be in the character + ;; literal $^ or part of string and $ outside of a string denotes + ;; a character literal) + ((= cs ?') + (cond + ((= (following-char) ?\") ;; $ or ^ was the last char in a string + (forward-char 1)) + (t + ;; Maybe a character literal, quote the next char to avoid + ;; situations as $" being seen as the begining of a string. + ;; Note the quoting something in the middle of a string is harmless. + (quote (following-char)) + (forward-char 1)))) + + ;; Symbol constituent or punctuation + + ((memq cs '(?. ?_)) + (cond + + ;; Clause end + ((= (following-char) ?\;) + (if (and stack (and (eq (car (car stack)) 'when) + (eq (car (car (cdr (cdr stack)))) 'spec))) + (erlang-pop stack)) + (if (and stack (eq (car (car stack)) '->)) + (erlang-pop stack)) + (forward-char 1)) + + ;; Parameter separator + ((looking-at ",") + (forward-char 1) + (if (and stack (eq (car (car stack)) '::)) + ;; Type or spec + (erlang-pop stack))) + + ;; Function end + ((looking-at "\\.\\(\\s \\|\n\\|\\s<\\)") + (setq stack nil) + (forward-char 1)) + + ;; Function head + ((looking-at "->") + (if (and stack (eq (car (car stack)) 'when)) + (erlang-pop stack)) + (erlang-push (list '-> token (current-column)) stack) + (forward-char 2)) + + ;; List-comprehension divider + ((looking-at "||") + (erlang-push (list '|| token (current-column)) stack) + (forward-char 2)) + + ;; Bit-syntax open paren + ((looking-at "<<") + (erlang-push (list '<< token (current-column)) stack) + (forward-char 2)) + + ;; Bbit-syntax close paren + ((looking-at ">>") + (while (memq (car (car stack)) '(|| ->)) + (erlang-pop stack)) + (cond ((eq (car (car stack)) '<<) + (erlang-pop stack)) + ((memq (car (car stack)) '(icr begin fun)) + (error "Missing `end'")) + (t + (error "Unbalanced parentheses"))) + (forward-char 2)) + + ;; Macro + ((= (following-char) ??) + ;; Skip over the ? + (forward-char 1) + ) + + ;; Type spec's + ((looking-at "-type\\s \\|-opaque\\s ") + (if stack + (forward-char 1) + (erlang-push (list 'icr token (current-column)) stack) + (forward-char 6))) + ((looking-at "-spec\\s ") + (if stack + (forward-char 1) + (forward-char 6) + (skip-chars-forward "^(\n") + (erlang-push (list 'spec (point) (current-column)) stack) + )) + + ;; Type spec delimiter + ((looking-at "::") + (erlang-push (list ':: token (current-column)) stack) + (forward-char 2)) + + ;; Don't follow through in the clause below + ;; '|' don't need spaces around it + ((looking-at "|") + (forward-char 1)) + + ;; Other punctuation: Skip over it and any following punctuation + ((= cs ?.) + ;; Skip over all characters in the operand. + (skip-syntax-forward ".")) + + ;; Other char: Skip over it. + (t + (forward-char 1)))) + + ;; Open parenthesis + ((= cs ?\() + (erlang-push (list '\( token (current-column)) stack) + (forward-char 1)) + + ;; Close parenthesis + ((= cs ?\)) + (while (memq (car (car stack)) '(|| -> :: when)) + (erlang-pop stack)) + (cond ((eq (car (car stack)) '\() + (erlang-pop stack) + (if (and (eq (car (car stack)) 'fun) + (eq (car (car (cdr stack))) '::)) + ;; Inside fun type def ') closes fun definition + (erlang-pop stack))) + ((eq (car (car stack)) 'icr) + (erlang-pop stack) + ;; Normal catch not try-catch might have caused icr + ;; and then incr should be removed and is not an error. + (if (eq (car (car stack)) '\() + (erlang-pop stack) + (error "Missing `end'") + )) + ((eq (car (car stack)) 'begin) + (error "Missing `end'")) + (t + (error "Unbalanced parenthesis")) + ) + (forward-char 1)) + + ;; Character quote: Skip it and the quoted char. + ((= cs ?/) + (forward-char 2)) + + ;; Character escape: Skip it and the escape sequence. + ((= cs ?\\) + (forward-char 1) + (skip-syntax-forward "w")) + + ;; Everything else + (t + (forward-char 1))) + (list stack token cs in-what))) + +(defun erlang-calculate-stack-indent (indent-point state) + "From the given last position and state (stack) calculate indentation. +Return nil if inside string, t if in a comment." + (let* ((stack (and state (car state))) + (token (nth 1 state)) + (stack-top (and stack (car stack)))) + (cond ((null state) ;No state + 0) + ((nth 3 state) + ;; Return nil or t. + (eq (nth 3 state) 'comment)) + ((null stack) + (if (looking-at "when[^_a-zA-Z0-9]") + erlang-indent-guard + 0)) + ((eq (car stack-top) '\() + ;; Element of list, tuple or part of an expression, + (cond ((null erlang-argument-indent) + ;; indent to next column. + (1+ (nth 2 stack-top))) + ((= (char-syntax (following-char)) ?\)) + (goto-char (nth 1 stack-top)) + (cond ((looking-at "[({]\\s *\\($\\|%\\)") + ;; Line ends with parenthesis. + (let ((previous (erlang-indent-find-preceding-expr)) + (stack-pos (nth 2 stack-top))) + (if (>= previous stack-pos) stack-pos + (- (+ previous erlang-argument-indent) 1)))) + (t + (nth 2 stack-top)))) + (t + (goto-char (nth 1 stack-top)) + (cond ((looking-at "[({]\\s *\\($\\|%\\)") + ;; Line ends with parenthesis. + (erlang-indent-parenthesis (nth 2 stack-top))) + (t + ;; Indent to the same column as the first + ;; argument. + (goto-char (1+ (nth 1 stack-top))) + (skip-chars-forward " \t") + (current-column)))))) + ;; + ((eq (car stack-top) '<<) + ;; Element of binary (possible comprehension) expression, + (cond ((null erlang-argument-indent) + ;; indent to next column. + (+ 2 (nth 2 stack-top))) + ((looking-at "\\(>>\\)[^_a-zA-Z0-9]") + (nth 2 stack-top)) + (t + (goto-char (nth 1 stack-top)) + ;; Indent to the same column as the first + ;; argument. + (goto-char (+ 2 (nth 1 stack-top))) + (skip-chars-forward " \t") + (current-column)))) + + ((memq (car stack-top) '(icr fun spec)) + ;; The default indentation is the column of the option + ;; directly following the keyword. (This does not apply to + ;; `case'.) Should no option be on the same line, the + ;; indentation is the indentation of the keyword + + ;; `erlang-indent-level'. + ;; + ;; `after' should be indented to the same level as the + ;; corresponding receive. + (cond ((looking-at "\\(after\\|catch\\|of\\)\\($\\|[^_a-zA-Z0-9]\\)") + (nth 2 stack-top)) + ((looking-at "when[^_a-zA-Z0-9]") + ;; Handling one when part + (+ (nth 2 stack-top) erlang-indent-level erlang-indent-guard)) + (t + (save-excursion + (goto-char (nth 1 stack-top)) + (if (looking-at "case[^_a-zA-Z0-9]") + (+ (nth 2 stack-top) erlang-indent-level) + (skip-chars-forward "a-z") + (skip-chars-forward " \t") + (if (memq (following-char) '(?% ?\n)) + (+ (nth 2 stack-top) erlang-indent-level) + (current-column)))))) + ) + ((and (eq (car stack-top) '||) (looking-at "\\(]\\|>>\\)[^_a-zA-Z0-9]")) + (nth 2 (car (cdr stack)))) + ;; Real indentation, where operators create extra indentation etc. + ((memq (car stack-top) '(-> || begin try)) + (if (looking-at "\\(of\\)[^_a-zA-Z0-9]") + (nth 2 stack-top) + (goto-char (nth 1 stack-top)) + ;; Check if there is more code after the '->' on the + ;; same line. If so use this indentation as base, else + ;; use parent indentation + 2 * level as base. + (let ((off erlang-indent-level) + (skip 2)) + (cond ((null (cdr stack))) ; Top level in function. + ((eq (car stack-top) 'begin) + (setq skip 5)) + ((eq (car stack-top) 'try) + (setq skip 5)) + ((eq (car stack-top) '->) + ;; If in fun definition use standard indent level not double + ;;(if (not (eq (car (car (cdr stack))) 'fun)) + ;; Removed it made multi clause fun's look to bad + (setq off (* 2 erlang-indent-level)))) ;; ) + (let ((base (erlang-indent-find-base stack indent-point off skip))) + ;; Special cases + (goto-char indent-point) + (cond ((looking-at "\\(end\\|after\\)\\($\\|[^_a-zA-Z0-9]\\)") + (if (eq (car stack-top) '->) + (erlang-pop stack)) + (if stack + (erlang-caddr (car stack)) + 0)) + ((looking-at "catch\\($\\|[^_a-zA-Z0-9]\\)") + (if (or (eq (car stack-top) 'try) + (eq (car (car (cdr stack))) 'icr)) + (progn + (if (eq (car stack-top) '->) + (erlang-pop stack)) + (if stack + (erlang-caddr (car stack)) + 0)) + base)) ;; old catch + (t + ;; Look at last thing to see how we are to move relative + ;; to the base. + (goto-char token) + (cond ((looking-at "||\\|,\\|->") + base) + ((erlang-at-keyword) + (+ (current-column) erlang-indent-level)) + ((or (= (char-syntax (following-char)) ?.) + (erlang-at-operator)) + (+ base erlang-indent-level)) + (t + (goto-char indent-point) + (cond ((memq (following-char) '(?\( ?{)) + ;; Function application or record. + (+ (erlang-indent-find-preceding-expr) + erlang-argument-indent)) + ;; Empty line, or end; treat it as the end of + ;; the block. (Here we have a choice: should + ;; the user be forced to reindent continued + ;; lines, or should the "end" be reindented?) + + ;; Avoid treating comments a continued line. + ((= (following-char) ?%) + base) + ;; Continued line (e.g. line beginning + ;; with an operator.) + (t (+ base erlang-indent-level))))))))) + )) + ((eq (car stack-top) 'when) + (goto-char (nth 1 stack-top)) + (if (looking-at "when\\s *\\($\\|%\\)") + (progn + (erlang-pop stack) + (if (and stack (memq (nth 0 (car stack)) '(icr fun))) + (progn + (goto-char (nth 1 (car stack))) + (+ (nth 2 (car stack)) erlang-indent-guard + ;; receive XYZ or receive + ;; XYZ + ;; This if thing does not seem to be needed + ;;(if (looking-at "[a-z]+\\s *\\($\\|%\\)") + ;; erlang-indent-level + ;; (* 2 erlang-indent-level)))) + (* 2 erlang-indent-level))) + ;;erlang-indent-level)) + (+ erlang-indent-level erlang-indent-guard))) + ;; "when" is followed by code, let's indent to the same + ;; column. + (forward-char 4) ; Skip "when" + (skip-chars-forward " \t") + (current-column))) + ;; Type and Spec indentation + ((eq (car stack-top) '::) + (cond ((null erlang-argument-indent) + ;; indent to next column. + (+ 2 (nth 2 stack-top))) + ((looking-at "::[^_a-zA-Z0-9]") + (nth 2 stack-top)) + (t + (goto-char (nth 1 stack-top)) + (cond ((looking-at "::\\s *\\($\\|%\\)") + ;; Line ends with :: + (+ (erlang-indent-find-preceding-expr 2) + erlang-argument-indent)) + ;; (* 2 erlang-indent-level)) + (t + ;; Indent to the same column as the first + ;; argument. + (goto-char (+ 2 (nth 1 stack-top))) + (skip-chars-forward " \t") + (current-column)))))) + ))) + + +(defun erlang-indent-find-base (stack indent-point &optional offset skip) + "Find the base column for current stack." + (or skip (setq skip 2)) + (or offset (setq offset erlang-indent-level)) + (save-excursion + (let* ((stack-top (car stack))) + (goto-char (nth 1 stack-top)) + (if (< skip (- (point-max) (point))) + (progn + (forward-char skip) + (if (looking-at "\\s *\\($\\|%\\)") + (progn + (if (memq (car stack-top) '(-> ||)) + (erlang-pop stack)) + ;; Take parent identation + offset, + ;; else just erlang-indent-level if no parent + (if stack + (+ (erlang-caddr (car stack)) + offset) + erlang-indent-level)) + (erlang-skip-blank indent-point) + (current-column))) + (+ (current-column) skip))))) + + +;; Does not handle `begin' .. `end'. +(defun erlang-indent-find-preceding-expr (&optional arg) + "Return the first column of the preceding expression. +This assumes that the preceding expression is either simple +\(i.e. an atom) or parenthesized." + (save-excursion + (or arg (setq arg 1)) + (forward-sexp (- arg)) + (let ((col (current-column))) + (skip-chars-backward " \t") + ;; Needed to match the colon in "'foo':'bar'". + (if (not (memq (preceding-char) '(?# ?:))) + col + (backward-char 1) + (forward-sexp -1) + (current-column))))) + +(defun erlang-indent-parenthesis (stack-position) + (let ((previous (erlang-indent-find-preceding-expr))) + (if (> previous stack-position) + (+ stack-position erlang-argument-indent) + (+ previous erlang-argument-indent)))) + +(defun erlang-skip-blank (&optional lim) + "Skip over whitespace and comments until limit reached." + (or lim (setq lim (point-max))) + (let (stop) + (while (and (not stop) (< (point) lim)) + (cond ((= (following-char) ?%) + (skip-chars-forward "^\n" lim)) + ((= (following-char) ?\n) + (skip-chars-forward "\n" lim)) + ((looking-at "\\s ") + (if (re-search-forward "\\S " lim 'move) + (forward-char -1))) + (t + (setq stop t)))) + stop)) + +(defun erlang-at-keyword () + "Are we looking at an Erlang keyword which will increase indentation?" + (looking-at (concat "\\(when\\|if\\|fun\\|case\\|begin\\|query\\|" + "of\\|receive\\|after\\|catch\\|try\\)[^_a-zA-Z0-9]"))) + +(defun erlang-at-operator () + "Are we looking at an Erlang operator?" + (looking-at + "\\(bnot\\|div\\|mod\\|band\\|bor\\|bxor\\|bsl\\|bsr\\)[^_a-zA-Z0-9]")) + +(defun erlang-comment-indent () + "Compute Erlang comment indentation. + +Used both by `indent-for-comment' and the Erlang specific indentation +commands." + (cond ((looking-at "%%%") 0) + ((looking-at "%%") + (or (erlang-calculate-indent) + (current-indentation))) + (t + (save-excursion + (skip-chars-backward " \t") + (max (if (bolp) 0 (1+ (current-column))) + comment-column))))) + +;;; Erlang movement commands + +;; All commands below work as movement commands. I.e. if the point is +;; at the end of the clause, and the command `erlang-end-of-clause' is +;; executed, the point is moved to the end of the NEXT clause. (This +;; mimics the behaviour of `end-of-defun'.) +;; +;; Personally I would like to rewrite them to be "pure", and add a set +;; of movement functions, like `erlang-next-clause', +;; `erlang-previous-clause', and the same for functions. +;; +;; The current implementation makes it hopeless to use the functions as +;; subroutines in more complex commands. /andersl + +(defun erlang-beginning-of-clause (&optional arg) + "Move backward to previous start of clause. +With argument, do this that many times. +Return t unless search stops due to end of buffer." + (interactive "p") + (or arg (setq arg 1)) + (if (< arg 0) + ;; Step back to the end of the previous line, unless we are at + ;; the beginning of the buffer. The reason for this move is + ;; that the regexp below includes the last character of the + ;; previous line. + (if (bobp) + (or (looking-at "\n") + (forward-char 1)) + (forward-char -1) + (if (looking-at "\\`\n") + (forward-char 1)))) + ;; The regexp matches a function header that isn't + ;; included in a string. + (and (re-search-forward "\\(\\`\\|\\`\n\\|[^\\]\n\\)\\(-?[a-z]\\|'\\|-\\)" + nil 'move (- arg)) + (let ((beg (match-beginning 2))) + (and beg (goto-char beg)) + t))) + +(defun erlang-end-of-clause (&optional arg) + "Move to the end of the current clause. +With argument, do this that many times." + (interactive "p") + (or arg (setq arg 1)) + (while (and (looking-at "[ \t]*[%\n]") + (zerop (forward-line 1)))) + ;; Move to the next clause. + (erlang-beginning-of-clause (- arg)) + (beginning-of-line);; Just to be sure... + (let ((continue t)) + (while (and (not (bobp)) continue) + (forward-line -1) + (skip-chars-forward " \t") + (if (looking-at "[%\n]") + nil + (end-of-line) + (setq continue nil))))) + +(defun erlang-mark-clause () + "Put mark at end of clause, point at beginning." + (interactive) + (push-mark (point)) + (erlang-end-of-clause 1) + ;; Sets the region. In Emacs 19 and XEmacs, we want to activate + ;; the region. + (condition-case nil + (push-mark (point) nil t) + (error (push-mark (point)))) + (erlang-beginning-of-clause 1) + ;; The above function deactivates the mark. + (if (boundp 'deactivate-mark) + (funcall (symbol-function 'set) 'deactivate-mark nil))) + +(defun erlang-beginning-of-function (&optional arg) + "Move backward to previous start of function. +With positive argument, do this that many times. +With negative argument, search forward. + +Return t unless search stops due to end of buffer." + (interactive "p") + (or arg (setq arg 1)) + (cond + ;; Search backward + ((> arg 0) + (while (and (> arg 0) + (and (erlang-beginning-of-clause 1) + (let ((start (point)) + (name (erlang-name-of-function)) + (arity (erlang-get-function-arity))) + ;; Note: "arity" is nil for e.g. "-import", hence + ;; two "-import" clauses are not considered to + ;; be part of the same function. + (while (and (erlang-beginning-of-clause 1) + (string-equal name + (erlang-name-of-function)) + arity + (equal arity + (erlang-get-function-arity))) + (setq start (point))) + (goto-char start) + t))) + (setq arg (1- arg)))) + ;; Search forward + ((< arg 0) + (end-of-line) + (erlang-beginning-of-clause 1) + ;; Step -arg functions forward. + (while (and (< arg 0) + ;; Step one function forward, or stop if the end of + ;; the buffer was reached. Return t if we found the + ;; function. + (let ((name (erlang-name-of-function)) + (arity (erlang-get-function-arity)) + (found (erlang-beginning-of-clause -1))) + (while (and found + (string-equal name (erlang-name-of-function)) + arity + (equal arity + (erlang-get-function-arity))) + (setq found (erlang-beginning-of-clause -1))) + found)) + (setq arg (1+ arg))))) + (zerop arg)) + + +(defun erlang-end-of-function (&optional arg) + "Move forward to next end of function. + +With argument, do this that many times. +With negative argument go towards the beginning of the buffer." + (interactive "p") + (or arg (setq arg 1)) + (let ((first t)) + ;; Forward + (while (and (> arg 0) (< (point) (point-max))) + (let ((pos (point))) + (while (progn + (if (and first + (progn + (forward-char 1) + (erlang-beginning-of-clause 1))) + nil + (or (bobp) (forward-char -1)) + (erlang-beginning-of-clause -1)) + (setq first nil) + (erlang-pass-over-function) + (skip-chars-forward " \t") + (if (looking-at "[%\n]") + (forward-line 1)) + (<= (point) pos)))) + (setq arg (1- arg))) + ;; Backward + (while (< arg 0) + (let ((pos (point))) + (erlang-beginning-of-clause 1) + (erlang-pass-over-function) + (forward-line 1) + (if (>= (point) pos) + (if (erlang-beginning-of-function 2) + (progn + (erlang-pass-over-function) + (skip-chars-forward " \t") + (if (looking-at "[%\n]") + (forward-line 1))) + (goto-char (point-min))))) + (setq arg (1+ arg))))) + +(eval-and-compile + (if (default-boundp 'beginning-of-defun-function) + (defalias 'erlang-mark-function 'mark-defun) + (defun erlang-mark-function () + "Put mark at end of function, point at beginning." + (interactive) + (push-mark (point)) + (erlang-end-of-function 1) + ;; Sets the region. In Emacs 19 and XEmacs, we want to activate + ;; the region. + (condition-case nil + (push-mark (point) nil t) + (error (push-mark (point)))) + (erlang-beginning-of-function 1) + ;; The above function deactivates the mark. + (if (boundp 'deactivate-mark) + (funcall (symbol-function 'set) 'deactivate-mark nil))))) + +(defun erlang-pass-over-function () + (while (progn + (erlang-skip-blank) + (and (not (looking-at "\\.\\(\\s \\|\n\\|\\s<\\)")) + (not (eobp)))) + (forward-sexp 1)) + (if (not (eobp)) + (forward-char 1))) + +(defun erlang-name-of-function () + (save-excursion + ;; Skip over attribute leader. + (if (looking-at "-[ \t]*") + (re-search-forward "-[ \t]*" nil 'move)) + (let ((start (point))) + (forward-sexp 1) + (buffer-substring start (point))))) + + +;;; Miscellaneous + +(defun erlang-fill-paragraph (&optional justify) + "Like \\[fill-paragraph], but handle Erlang comments. +If any of the current line is a comment, fill the comment or the +paragraph of it that point is in, preserving the comment's indentation +and initial `%':s." + (interactive "P") + (let ((has-comment nil) + ;; If has-comment, the appropriate fill-prefix for the comment. + comment-fill-prefix) + ;; Figure out what kind of comment we are looking at. + (save-excursion + (beginning-of-line) + (cond + ;; Find the command prefix. + ((looking-at (concat "\\s *" comment-start-skip)) + (setq has-comment t) + (setq comment-fill-prefix (buffer-substring (match-beginning 0) + (match-end 0)))) + ;; A line with some code, followed by a comment? Remember that the + ;; % which starts the comment shouldn't be part of a string or + ;; character. + ((progn + (while (not (looking-at "%\\|$")) + (skip-chars-forward "^%\n\"\\\\") + (cond + ((eq (char-after (point)) ?\\) (forward-char 2)) + ((eq (char-after (point)) ?\") (forward-sexp 1)))) + (looking-at comment-start-skip)) + (setq has-comment t) + (setq comment-fill-prefix + (concat (make-string (current-column) ? ) + (buffer-substring (match-beginning 0) (match-end 0))))))) + (if (not has-comment) + (fill-paragraph justify) + ;; Narrow to include only the comment, and then fill the region. + (save-restriction + (narrow-to-region + ;; Find the first line we should include in the region to fill. + (save-excursion + (while (and (zerop (forward-line -1)) + (looking-at "^\\s *%"))) + ;; We may have gone to far. Go forward again. + (or (looking-at "^\\s *%") + (forward-line 1)) + (point)) + ;; Find the beginning of the first line past the region to fill. + (save-excursion + (while (progn (forward-line 1) + (looking-at "^\\s *%"))) + (point))) + ;; Lines with only % on them can be paragraph boundaries. + (let ((paragraph-start (concat paragraph-start "\\|^[ \t%]*$")) + (paragraph-separate (concat paragraph-start "\\|^[ \t%]*$")) + (fill-prefix comment-fill-prefix)) + (fill-paragraph justify)))))) + + +(defun erlang-uncomment-region (beg end) + "Uncomment all commented lines in the region." + (interactive "r") + (uncomment-region beg end)) + + +(defun erlang-generate-new-clause () + "Create additional Erlang clause header. + +Parses the source file for the name of the current Erlang function. +Create the header containing the name, A pair of parentheses, +and an arrow. The space between the function name and the +first parenthesis is preserved. The point is placed between +the parentheses." + (interactive) + (let ((name (save-excursion + (and (erlang-beginning-of-clause) + (erlang-get-function-name t)))) + (arrow (save-excursion + (and (erlang-beginning-of-clause) + (erlang-get-function-arrow))))) + (if (or (null arrow) (null name)) + (error "Can't find name of current Erlang function")) + (if (and (bolp) (eolp)) + nil + (end-of-line) + (newline)) + (insert name) + (save-excursion + (insert ") " arrow)) + (if erlang-new-clause-with-arguments + (erlang-clone-arguments)))) + + +(defun erlang-clone-arguments () + "Insert, at the point, the argument list of the previous clause. + +The mark is set at the beginning of the inserted text, the point +at the end." + (interactive) + (let ((args (save-excursion + (beginning-of-line) + (and (erlang-beginning-of-clause) + (erlang-get-function-arguments)))) + (p (point))) + (if (null args) + (error "Can't clone argument list")) + (insert args) + (set-mark p))) + +;;; Information retrieval functions. + +(defun erlang-buffer-substring (beg end) + "Like `buffer-substring-no-properties'. +Although, this function works on all versions of Emacs." + (if (fboundp 'buffer-substring-no-properties) + (funcall (symbol-function 'buffer-substring-no-properties) beg end) + (buffer-substring beg end))) + + +(defun erlang-get-module () + "Return the name of the module as specified by `-module'. + +Return nil if file contains no `-module' attribute." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let ((md (match-data))) + (unwind-protect + (if (re-search-forward + (eval-when-compile + (concat "^-module\\s *(\\s *\\(\\(" + erlang-atom-regexp + "\\)?\\)\\s *)\\s *\\.")) + (point-max) t) + (erlang-remove-quotes + (erlang-buffer-substring (match-beginning 1) + (match-end 1))) + nil) + (store-match-data md)))))) + + +(defun erlang-get-module-from-file-name (&optional file) + "Extract the module name from a file name. + +First, the directory part is removed. Second, the part of the file name +matching `erlang-file-name-extension-regexp' is removed. + +Should the match fail, nil is returned. + +By modifying `erlang-file-name-extension-regexp' to match files other +than Erlang source files, Erlang specific functions could be applied on +non-Erlang files. Most notably; the support for Erlang modules in the +tags system could be used by files written in other languages." + (or file (setq file buffer-file-name)) + (if (null file) + nil + (setq file (file-name-nondirectory file)) + (if (string-match erlang-file-name-extension-regexp file) + (substring file 0 (match-beginning 0)) + nil))) + + +;; Used by `erlang-get-export' and `erlang-get-import'. + +(defun erlang-get-function-arity-list () + "Parse list of `function/arity' as used by `-import' and `-export'. + +Point must be before the opening bracket. When the +function returns the point will be placed after the closing bracket. + +The function does not return an error if the list is incorrectly +formatted. + +Return list of (function . arity). The order of the returned list +corresponds to the order of the parsed Erlang list." + (let ((res '())) + (erlang-skip-blank) + (forward-char 1) + (if (not (eq (preceding-char) ?\[)) + '() ; Not looking at an Erlang list. + (while ; Note: `while' has no body. + (progn + (erlang-skip-blank) + (and (looking-at (eval-when-compile + (concat erlang-atom-regexp "/\\([0-9]+\\)\\>"))) + (progn + (setq res (cons + (cons + (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 1) (match-end 1))) + (erlang-string-to-int + (erlang-buffer-substring + (match-beginning + (+ 1 erlang-atom-regexp-matches)) + (match-end + (+ 1 erlang-atom-regexp-matches))))) + res)) + (goto-char (match-end 0)) + (erlang-skip-blank) + (forward-char 1) + ;; Test if there are more exported functions. + (eq (preceding-char) ?,)))))) + (nreverse res))) + + +;;; Note that `-export' and the open parenthesis must be written on +;;; the same line. + +(defun erlang-get-export () + "Return a list of `(function . arity)' as specified by `-export'." + (save-excursion + (goto-char (point-min)) + (let ((md (match-data)) + (res '())) + (unwind-protect + (progn + (while (re-search-forward "^-export\\s *(" (point-max) t) + (erlang-skip-blank) + (setq res (nconc res (erlang-get-function-arity-list)))) + res) + (store-match-data md))))) + + +(defun erlang-get-import () + "Parse an Erlang source file for imported functions. + +Return an alist with module name as car part and list of conses containing +function and arity as cdr part." + (save-excursion + (goto-char (point-min)) + (let ((md (match-data)) + (res '())) + (unwind-protect + (progn + (while (re-search-forward "^-import\\s *(" (point-max) t) + (erlang-skip-blank) + (if (looking-at erlang-atom-regexp) + (let ((module (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 0) + (match-end 0))))) + (goto-char (match-end 0)) + (erlang-skip-blank) + (if (eq (following-char) ?,) + (progn + (forward-char 1) + (erlang-skip-blank) + (let ((funcs (erlang-get-function-arity-list)) + (pair (assoc module res))) + (if pair + (setcdr pair (nconc (cdr pair) funcs)) + (setq res (cons (cons module funcs) + res))))))))) + (nreverse res)) + (store-match-data md))))) + + +(defun erlang-get-function-name (&optional arg) + "Return name of current function, or nil. + +If optional argument is non-nil, everything up to and including +the first `(' is returned. + +Normally used in conjunction with `erlang-beginning-of-clause', e.g.: + (save-excursion + (if (not (eobp)) (forward-char 1)) + (and (erlang-beginning-of-clause) + (erlang-get-function-name t)))" + (let ((n (if arg 0 1))) + (and (looking-at (eval-when-compile + (concat "^" erlang-atom-regexp "\\s *("))) + (erlang-buffer-substring (match-beginning n) (match-end n))))) + + +(defun erlang-get-function-arrow () + "Return arrow of current function, could be \"->\" or nil. + +Normally used in conjunction with `erlang-beginning-of-clause', e.g.: + (save-excursion + (if (not (eobp)) (forward-char 1)) + (and (erlang-beginning-of-clause) + (erlang-get-function-arrow)))" + (and + (save-excursion + (re-search-forward "[^-:]*-\\|:" (point-max) t) + (erlang-buffer-substring (- (point) 1) (+ (point) 1))))) + +(defun erlang-get-function-arity () + "Return the number of arguments of function at point, or nil." + (and (looking-at (eval-when-compile + (concat "^" erlang-atom-regexp "\\s *("))) + (save-excursion + (goto-char (match-end 0)) + (condition-case nil + (let ((res 0) + (cont t)) + (while cont + (cond ((eobp) + (setq res nil) + (setq cont nil)) + ((looking-at "\\s *)") + (setq cont nil)) + ((looking-at "\\s *\\($\\|%\\)") + (forward-line 1)) + ((looking-at "\\s *,") + (setq res (+ 1 res)) + (goto-char (match-end 0))) + (t + (when (zerop res) + (setq res (+ 1 res))) + (forward-sexp 1)))) + res) + (error nil))))) + +(defun erlang-get-function-arguments () + "Return arguments of current function, or nil." + (if (not (looking-at (eval-when-compile + (concat "^" erlang-atom-regexp "\\s *(")))) + nil + (save-excursion + (condition-case nil + (let ((start (match-end 0))) + (goto-char (- start 1)) + (forward-sexp) + (erlang-buffer-substring start (- (point) 1))) + (error nil))))) + + +(defun erlang-get-function-under-point () + "Return the module and function under the point, or nil. + +Should no explicit module name be present at the point, the +list of imported functions is searched. + +The following could be returned: + (\"module\" \"function\") -- Both module and function name found. + (nil \"function\") -- No module name was found. + nil -- No function name found + +In the future the list may contain more elements." + (save-excursion + (let ((md (match-data)) + (res nil)) + (if (eq (char-syntax (following-char)) ? ) + (skip-chars-backward " \t")) + (skip-chars-backward "a-zA-Z0-9_:'") + (cond ((looking-at (eval-when-compile + (concat erlang-atom-regexp ":" erlang-atom-regexp))) + (setq res (list + (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 1) (match-end 1))) + (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning (1+ erlang-atom-regexp-matches)) + (match-end (1+ erlang-atom-regexp-matches))))))) + ((looking-at erlang-atom-regexp) + (let ((fk (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 0) (match-end 0)))) + (mod nil) + (imports (erlang-get-import))) + (while (and imports (null mod)) + (if (assoc fk (cdr (car imports))) + (setq mod (car (car imports))) + (setq imports (cdr imports)))) + (setq res (list mod fk))))) + (store-match-data md) + res))) + + +;; TODO: Escape single quotes inside the string without +;; replace-regexp-in-string. +(defun erlang-add-quotes-if-needed (str) + "Return STR, possibly with quotes." + (let ((case-fold-search nil)) ; force string matching to be case sensitive + (if (and (stringp str) + (not (string-match (eval-when-compile + (concat "\\`" erlang-atom-regexp "\\'")) str))) + (progn (if (fboundp 'replace-regexp-in-string) + (setq str (replace-regexp-in-string "'" "\\'" str t t ))) + (concat "'" str "'")) + str))) + + +(defun erlang-remove-quotes (str) + "Return STR without quotes, if present." + (let ((md (match-data))) + (prog1 + (if (string-match "\\`'\\(.*\\)'\\'" str) + (substring str 1 -1) + str) + (store-match-data md)))) + + +;;; Check module name + +;; The function `write-file', bound to C-x C-w, calls +;; `set-visited-file-name' which clears the hook. :-( +;; To make sure that the hook always is present, we advise +;; `set-visited-file-name'. +(defun erlang-check-module-name-init () + "Initialize the functionality to compare file and module names. + +Unless we have `before-save-hook', we redefine the function +`set-visited-file-name' since it clears the variable +`local-write-file-hooks'. The original function definition is +stored in `erlang-orig-set-visited-file-name'." + (if (boundp 'before-save-hook) + ;; If we have that, `make-local-hook' is obsolete. + (add-hook 'before-save-hook 'erlang-check-module-name nil t) + (require 'advice) + (unless (ad-advised-definition-p 'set-visited-file-name) + (defadvice set-visited-file-name (after erlang-set-visited-file-name + activate) + (if (eq major-mode 'erlang-mode) + (add-hook 'local-write-file-hooks 'erlang-check-module-name)))) + (add-hook 'local-write-file-hooks 'erlang-check-module-name))) + + +(defun erlang-check-module-name () + "If the module name doesn't match file name, ask for permission to change. + +The variable `erlang-check-module-name' controls the behaviour of this +function. It it is nil, this function does nothing. If it is t, the +source is silently changed. If it is set to the atom `ask', the user +is prompted. + +This function is normally placed in the hook `local-write-file-hooks'." + (if erlang-check-module-name + (let ((mn (erlang-add-quotes-if-needed + (erlang-get-module))) + (fn (erlang-add-quotes-if-needed + (erlang-get-module-from-file-name (buffer-file-name))))) + (if (and (stringp mn) (stringp fn)) + (or (string-equal mn fn) + (if (or (eq erlang-check-module-name t) + (y-or-n-p + "Module does not match file name. Modify source? ")) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (if (re-search-forward + (eval-when-compile + (concat "^-module\\s *(\\s *\\(\\(" + erlang-atom-regexp + "\\)?\\)\\s *)\\s *\\.")) + (point-max) t) + (progn + (goto-char (match-beginning 1)) + (delete-region (match-beginning 1) + (match-end 1)) + (insert fn)))))))))) + ;; Must return nil since it is added to `local-write-file-hook'. + nil) + + +;;; Electric functions. + +(defun erlang-electric-semicolon (&optional arg) + "Insert a semicolon character and possibly a prototype for the next line. + +The variable `erlang-electric-semicolon-criteria' states a criterion, +when fulfilled a newline is inserted, the next line is indented and a +prototype for the next line is inserted. Normally the prototype +consists of \" ->\". Should the semicolon end the clause a new clause +header is generated. + +The variable `erlang-electric-semicolon-insert-blank-lines' controls +the number of blank lines inserted between the current line and new +function header. + +Behaves just like the normal semicolon when supplied with a +numerical arg, point is inside string or comment, or when there are +non-whitespace characters following the point on the current line." + (interactive "P") + (self-insert-command (prefix-numeric-value arg)) + (if (or arg + (and (listp erlang-electric-commands) + (not (memq 'erlang-electric-semicolon + erlang-electric-commands))) + (erlang-in-literal) + (not (looking-at "\\s *\\(%.*\\)?$")) + (null (erlang-test-criteria-list + erlang-electric-semicolon-criteria))) + (setq erlang-electric-newline-inhibit nil) + (setq erlang-electric-newline-inhibit t) + (undo-boundary) + (end-of-line) + (newline) + (if (condition-case nil + (progn (erlang-indent-line) t) + (error (if (bolp) (delete-backward-char 1)))) + (if (not (bolp)) + (save-excursion + (insert " ->")) + (condition-case nil + (progn + (erlang-generate-new-clause) + (if erlang-electric-semicolon-insert-blank-lines + (save-excursion + (beginning-of-line) + (newline + erlang-electric-semicolon-insert-blank-lines)))) + (error (if (bolp) (delete-backward-char 1)))))))) + + +(defun erlang-electric-comma (&optional arg) + "Insert a comma character and possibly a new indented line. +The variable `erlang-electric-comma-criteria' states a criterion, +when fulfilled a newline is inserted and the next line is indented. + +Behaves just like the normal comma when supplied with a +numerical arg, point is inside string or comment, or when there are +non-whitespace characters following the point on the current line." + (interactive "P") + + (self-insert-command (prefix-numeric-value arg)) + + (if (or arg + (and (listp erlang-electric-commands) + (not (memq 'erlang-electric-comma erlang-electric-commands))) + (erlang-in-literal) + (not (looking-at "\\s *\\(%.*\\)?$")) + (null (erlang-test-criteria-list + erlang-electric-comma-criteria))) + (setq erlang-electric-newline-inhibit nil) + (setq erlang-electric-newline-inhibit t) + (undo-boundary) + (end-of-line) + (newline) + (condition-case nil + (erlang-indent-line) + (error (if (bolp) (delete-backward-char 1)))))) + +(defun erlang-electric-lt (&optional arg) + "Insert a less-than sign, and optionally mark it as an open paren." + + (interactive "p") + + (self-insert-command arg) + + ;; Was this the second char in bit-syntax open (`<<')? + (unless (< (point) 2) + (save-excursion + (backward-char 2) + (when (and (eq (char-after (point)) ?<) + (not (eq (get-text-property (point) 'category) + 'bitsyntax-open-inner))) + ;; Then mark the two chars... + (put-text-property (point) (1+ (point)) + 'category 'bitsyntax-open-outer) + (forward-char 1) + (put-text-property (point) (1+ (point)) + 'category 'bitsyntax-open-inner) + ;;...and unmark any subsequent less-than chars. + (forward-char 1) + (while (eq (char-after (point)) ?<) + (remove-text-properties (point) (1+ (point)) + '(category nil)) + (forward-char 1)))))) + +(defun erlang-after-bitsyntax-close () + "Return t if point is immediately after a bit-syntax close parenthesis (`>>')." + (and (>= (point) 2) + (save-excursion + (backward-char 2) + (and (eq (char-after (point)) ?>) + (not (eq (get-text-property (point) 'category) + 'bitsyntax-close-outer)))))) + +(defun erlang-after-arrow () + "Return true if point is immediately after a function arrow (`->')." + (and (>= (point) 2) + (and + (save-excursion + (backward-char) + (eq (char-before (point)) ?-)) + (or (not (listp erlang-electric-commands)) + (memq 'erlang-electric-gt + erlang-electric-commands)) + (not (erlang-in-literal)) + (looking-at "\\s *\\(%.*\\)?$") + (erlang-test-criteria-list erlang-electric-arrow-criteria)))) + + +(defun erlang-electric-gt (&optional arg) + "Insert a greater-than sign, and optionally mark it as a close paren." + + (interactive "p") + + (self-insert-command arg) + + (cond + ;; Did we just write a bit-syntax close (`>>')? + ((erlang-after-bitsyntax-close) + (save-excursion + ;; Then mark the two chars... + (backward-char 2) + (put-text-property (point) (1+ (point)) + 'category 'bitsyntax-close-inner) + (forward-char) + (put-text-property (point) (1+ (point)) + 'category 'bitsyntax-close-outer) + ;;...and unmark any subsequent greater-than chars. + (forward-char) + (while (eq (char-after (point)) ?>) + (remove-text-properties (point) (1+ (point)) + '(category nil)) + (forward-char)))) + + ;; Did we just write a function arrow (`->')? + ((erlang-after-arrow) + (let ((erlang-electric-newline-inhibit t)) + (undo-boundary) + (end-of-line) + (newline) + (condition-case nil + (erlang-indent-line) + (error (if (bolp) (delete-backward-char 1)))))) + + ;; Then it's just a plain greater-than. + (t + nil))) + + +(defun erlang-electric-arrow\ off (&optional arg) + "Insert a '>'-sign and possibly a new indented line. + +This command is only `electric' when the `>' is part of an `->' arrow. +The variable `erlang-electric-arrow-criteria' states a sequence of +criteria, which decides when a newline should be inserted and the next +line indented. + +It behaves just like the normal greater than sign when supplied with a +numerical arg, point is inside string or comment, or when there are +non-whitespace characters following the point on the current line. + +After being split/merged into `erlang-after-arrow' and +`erlang-electric-gt', it is now unused and disabled." + (interactive "P") + (let ((prec (preceding-char))) + (self-insert-command (prefix-numeric-value arg)) + (if (or arg + (and (listp erlang-electric-commands) + (not (memq 'erlang-electric-arrow + erlang-electric-commands))) + (not (eq prec ?-)) + (erlang-in-literal) + (not (looking-at "\\s *\\(%.*\\)?$")) + (null (erlang-test-criteria-list + erlang-electric-arrow-criteria))) + (setq erlang-electric-newline-inhibit nil) + (setq erlang-electric-newline-inhibit t) + (undo-boundary) + (end-of-line) + (newline) + (condition-case nil + (erlang-indent-line) + (error (if (bolp) (delete-backward-char 1))))))) + + +(defun erlang-electric-newline (&optional arg) + "Break line at point and indent, continuing comment if within one. +The variable `erlang-electric-newline-criteria' states a criterion, +when fulfilled a newline is inserted and the next line is indented. + +Should the current line begin with a comment, and the variable +`comment-multi-line' be non-nil, a new comment start is inserted. + +Should the previous command be another electric command we assume that +the user pressed newline out of old habit, hence we will do nothing." + (interactive "P") + (cond ((and (not arg) + erlang-electric-newline-inhibit + (memq last-command erlang-electric-newline-inhibit-list)) + ()) ; Do nothing! + ((or arg + (and (listp erlang-electric-commands) + (not (memq 'erlang-electric-newline + erlang-electric-commands))) + (null (erlang-test-criteria-list + erlang-electric-newline-criteria))) + (newline (prefix-numeric-value arg))) + (t + (if (and comment-multi-line + (save-excursion + (beginning-of-line) + (looking-at (concat "\\s *" comment-start-skip)))) + (let ((str (buffer-substring + (or (match-end 1) (match-beginning 0)) + (min (match-end 0) (point))))) + (newline) + (undo-boundary) + (insert str)) + (newline) + (undo-boundary) + (indent-according-to-mode))))) + + +(defun erlang-test-criteria-list (criteria) + "Given a list of criterion functions, test if criteria are fulfilled. + +Each element in the criteria list can a function returning nil, t or +the atom `stop'. t means that the criterion is fulfilled, `stop' means +that it isn't fulfilled and that the search should stop, +and nil means continue searching. + +Should the list contain the atom t the criterion is assumed to be +fulfilled, unless preceded by a function returning `stop', of course. + +Should the argument be the atom t instead of a list, the criterion is +assumed to be trivially true. + +Should all functions return nil, the criteria are assumed not to be +fulfilled. + +Return t if criteria fulfilled, nil otherwise." + (if (eq criteria t) + t + (save-excursion + (let ((answer nil)) + (while (and criteria (null answer)) + (if (eq (car criteria) t) + (setq answer t) + (setq answer (funcall (car criteria)))) + (setq criteria (cdr criteria))) + (if (and answer (not (eq answer 'stop))) + t + nil))))) + + +(defun erlang-in-literal (&optional lim) + "Test if point is in string, quoted atom or comment. + +Return one of the three atoms `atom', `string', and `comment'. +Should the point be inside none of the above mentioned types of +context, nil is returned." + (save-excursion + (let* ((lim (or lim (save-excursion + (erlang-beginning-of-clause) + (point)))) + (state (if (fboundp 'syntax-ppss) ; post Emacs 21.3 + (funcall (symbol-function 'syntax-ppss)) + (parse-partial-sexp lim (point))))) + (cond + ((eq (nth 3 state) ?') 'atom) + ((nth 3 state) 'string) + ((nth 4 state) 'comment) + (t nil))))) + + +(defun erlang-at-end-of-function-p () + "Test if point is at end of an Erlang function. + +This function is designed to be a member of a criteria list." + (eq (save-excursion (erlang-skip-blank) (point)) + (save-excursion + (erlang-beginning-of-function -1) (point)))) + + +(defun erlang-at-end-of-clause-p () + "Test if point is at end of an Erlang clause. + +This function is designed to be a member of a criteria list." + (eq (save-excursion (erlang-skip-blank) (point)) + (save-excursion + (erlang-beginning-of-clause -1) (point)))) + + +(defun erlang-stop-when-inside-argument-list () + "Return `stop' if inside parenthesis list, nil otherwise. + +Knows about the list comprehension syntax. When the point is +after `||', `stop' is not returned. + +This function is designed to be a member of a criteria list." + (save-excursion + (condition-case nil + (let ((orig-point (point)) + (state nil)) + (up-list -1) + (if (not (eq (following-char) ?\[)) + 'stop + ;; Do not return `stop' when inside a list comprehension + ;; construction. (The point must be after `||'). + (while (< (point) orig-point) + (setq state (erlang-partial-parse (point) orig-point state))) + (if (and (car state) (eq (car (car (car state))) '||)) + nil + 'stop))) + (error + nil)))) + + +(defun erlang-stop-when-at-guard () + "Return `stop' when at function guards. + +This function is designed to be a member of a criteria list." + (save-excursion + (beginning-of-line) + (if (and (looking-at (eval-when-compile + (concat "^" erlang-atom-regexp "\\s *("))) + (not (looking-at + (eval-when-compile + (concat "^" erlang-atom-regexp ".*->"))))) + 'stop + nil))) + + +(defun erlang-next-lines-empty-p () + "Return non-nil if next lines are empty. + +The variable `erlang-next-lines-empty-threshold' contains the number +of lines required to be empty. + +A line containing only spaces and tabs is considered empty. + +This function is designed to be a member of a criteria list." + (and erlang-next-lines-empty-threshold + (save-excursion + (let ((left erlang-next-lines-empty-threshold) + (cont t)) + (while (and cont (> left 0)) + (forward-line 1) + (setq cont (looking-at "\\s *$")) + (setq left (- left 1))) + cont)))) + + +(defun erlang-at-keyword-end-p () + "Test if next readable token is the keyword end. + +This function is designed to be a member of a criteria list." + (save-excursion + (erlang-skip-blank) + (looking-at "end[^_a-zA-Z0-9]"))) + + +;; Erlang tags support which is aware of erlang modules. +;; +;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags +;; package works under XEmacs.) + +(eval-when-compile + (if (or (featurep 'bytecomp) + (featurep 'byte-compile)) + (progn + (require 'etags)))) + + +;; Variables: + +(defvar erlang-tags-function-alist + '((find-tag . erlang-find-tag) + (find-tag-other-window . erlang-find-tag-other-window) + (find-tag-regexp . erlang-find-tag-regexp) + (find-tag-other-frame . erlang-find-tag-other-frame)) + "Alist of old tags commands and the replacement functions.") + +(defvar erlang-tags-installed nil + "Non-nil when the Erlang tags system is installed.") +(defvar erlang-tags-file-list '() + "List of files in tag list. Used when finding tag on form `module:'.") +(defvar erlang-tags-completion-table nil + "Like `tags-completion-table', this table contains `tag' and `module:tag'.") +(defvar erlang-tags-buffer-installed-p nil + "Non-nil when Erlang module recognising functions installed.") +(defvar erlang-tags-buffer-list '() + "Temporary list of buffers.") +(defvar erlang-tags-orig-completion-table nil + "Temporary storage for `tags-completion-table'.") +(defvar erlang-tags-orig-tag-order nil + "Temporary storage for `find-tag-tag-order'.") +(defvar erlang-tags-orig-regexp-tag-order nil + "Temporary storage for `find-tag-regexp-tag-order'.") +(defvar erlang-tags-orig-search-function nil + "Temporary storage for `find-tag-search-function'.") +(defvar erlang-tags-orig-regexp-search-function nil + "Temporary storage for `find-tag-regexp-search-function'.") +(defvar erlang-tags-orig-format-hooks nil + "Temporary storage for `tags-table-format-hooks'.") ;v19 +(defvar erlang-tags-orig-format-functions nil + "Temporary storage for `tags-table-format-functions'.") ;v > 19 + +(defun erlang-tags-init () + "Install an alternate version of tags, aware of Erlang modules. + +After calling this function, the tags functions are aware of +Erlang modules. Tags can be entered on the for `module:tag' as well +as on the old form `tag'. + +In the completion list, `module:tag' and `module:' shows up. + +Call this function from an appropriate init file, or add it to +Erlang mode hook with the commands: + (add-hook 'erlang-mode-hook 'erlang-tags-init) + (add-hook 'erlang-shell-mode-hook 'erlang-tags-init) + +This function only works under Emacs 18 and Emacs 19. Currently, It +is not implemented under XEmacs. (Hint: The Emacs 19 etags module +works under XEmacs.)" + (interactive) + (cond ((= erlang-emacs-major-version 18) + (require 'tags) + (erlang-tags-define-keys (current-local-map)) + (setq erlang-tags-installed t)) + (t + (require 'etags) + ;; Test on a function available in the Emacs 19 version + ;; of tags but not in the XEmacs version. + (if (not (fboundp 'find-tag-noselect)) + () + (erlang-tags-define-keys (current-local-map)) + (setq erlang-tags-installed t))))) + + +;; Set all keys bound to `find-tag' et.al. in the global map and the +;; menu to `erlang-find-tag' et.al. in `map'. +;; +;; The function `substitute-key-definition' does not work properly +;; in all version of Emacs. + +(defun erlang-tags-define-keys (map) + "Bind tags commands to keymap MAP aware of Erlang modules." + (let ((alist erlang-tags-function-alist)) + (while alist + (let* ((old (car (car alist))) + (new (cdr (car alist))) + (keys (append (where-is-internal old global-map)))) + (while keys + (define-key map (car keys) new) + (setq keys (cdr keys)))) + (setq alist (cdr alist)))) + ;; Update the menu. + (erlang-menu-substitute erlang-menu-base-items erlang-tags-function-alist) + (erlang-menu-init)) + + +;; There exists a variable `find-tag-default-function'. It is not used +;; since `complete-tag' uses it to get current word under point. In that +;; situation we don't want the module to be prepended. + +(defun erlang-find-tag-default () + "Return the default tag. +Search `-import' list of imported functions. +Single quotes are been stripped away." + (let ((mod-func (erlang-get-function-under-point))) + (cond ((null mod-func) + nil) + ((null (car mod-func)) + (nth 1 mod-func)) + (t + (concat (car mod-func) ":" (nth 1 mod-func)))))) + + +;; Return `t' since it is used inside `tags-loop-form'. +;;;###autoload +(defun erlang-find-tag (modtagname &optional next-p regexp-p) + "Like `find-tag'. Capable of retrieving Erlang modules. + +Tags can be given on the forms `tag', `module:', `module:tag'." + (interactive (erlang-tag-interactive "Find `module:tag' or `tag': ")) + (switch-to-buffer (erlang-find-tag-noselect modtagname next-p regexp-p)) + t) + + +;; Code mainly from `find-tag-other-window' in `etags.el'. +;;;###autoload +(defun erlang-find-tag-other-window (tagname &optional next-p regexp-p) + "Like `find-tag-other-window' but aware of Erlang modules." + (interactive (erlang-tag-interactive + "Find `module:tag' or `tag' other window: ")) + + ;; This is to deal with the case where the tag is found in the + ;; selected window's buffer; without this, point is moved in both + ;; windows. To prevent this, we save the selected window's point + ;; before doing find-tag-noselect, and restore it afterwards. + (let* ((window-point (window-point (selected-window))) + (tagbuf (erlang-find-tag-noselect tagname next-p regexp-p)) + (tagpoint (progn (set-buffer tagbuf) (point)))) + (set-window-point (prog1 + (selected-window) + (switch-to-buffer-other-window tagbuf) + ;; We have to set this new window's point; it + ;; might already have been displaying a + ;; different portion of tagbuf, in which case + ;; switch-to-buffer-other-window doesn't set + ;; the window's point from the buffer. + (set-window-point (selected-window) tagpoint)) + window-point))) + + +(defun erlang-find-tag-other-frame (tagname &optional next-p) + "Like `find-tag-other-frame' but aware of Erlang modules." + (interactive (erlang-tag-interactive + "Find `module:tag' or `tag' other frame: ")) + (let ((pop-up-frames t)) + (erlang-find-tag-other-window tagname next-p))) + + +(defun erlang-find-tag-regexp (regexp &optional next-p other-window) + "Like `find-tag-regexp' but aware of Erlang modules." + (interactive (if (fboundp 'find-tag-regexp) + (erlang-tag-interactive + "Find `module:regexp' or `regexp': ") + (error "This version of Emacs can't find tags by regexps"))) + (funcall (if other-window + 'erlang-find-tag-other-window + 'erlang-find-tag) + regexp next-p t)) + + +;; Just like C-u M-. This could be added to the menu. +(defun erlang-find-next-tag () + "Find next tag, like \\[find-tag] with prefix arg." + (interactive) + (let ((current-prefix-arg '(4))) + (if erlang-tags-installed + (call-interactively 'erlang-find-tag) + (call-interactively 'find-tag)))) + + +;; Mimics `find-tag-noselect' found in `etags.el', but uses `find-tag' to +;; be compatible with `tags.el'. +;; +;; Handles three cases: +;; * `module:' Loop over all possible file names. Stop if a file-name +;; without extension and directory matches the module. +;; +;; * `module:tag' +;; Emacs 19: Replace test functions with functions aware of +;; Erlang modules. Tricky because the etags system wasn't +;; built for these kind of operations... +;; +;; Emacs 18: We loop over `find-tag' until we find a file +;; whose module matches the requested module. The +;; drawback is that a lot of files could be loaded into +;; Emacs. +;; +;; * `tag' Just give it to `find-tag'. + +(defun erlang-find-tag-noselect (modtagname &optional next-p regexp-p) + "Like `find-tag-noselect' but aware of Erlang modules." + (interactive (erlang-tag-interactive "Find `module:tag' or `tag': ")) + (or modtagname + (setq modtagname (symbol-value 'last-tag))) + (funcall (symbol-function 'set) 'last-tag modtagname) + ;; `tags.el' uses this variable to record how M-, would + ;; know where to restart a tags command. + (if (boundp 'tags-loop-form) + (funcall (symbol-function 'set) + 'tags-loop-form '(erlang-find-tag nil t))) + (save-window-excursion + (cond + ((string-match ":$" modtagname) + ;; Only the module name was given. Read all files whose file name + ;; match. + (let ((modname (substring modtagname 0 (match-beginning 0))) + (file nil)) + (if (not next-p) + (save-excursion + (visit-tags-table-buffer) + (setq erlang-tags-file-list + (funcall (symbol-function 'tags-table-files))))) + (while (null file) + (or erlang-tags-file-list + (save-excursion + (if (and (featurep 'etags) + (funcall + (symbol-function 'visit-tags-table-buffer) 'same) + (funcall + (symbol-function 'visit-tags-table-buffer) t)) + (setq erlang-tags-file-list + (funcall (symbol-function 'tags-table-files))) + (error "No %stags containing %s" (if next-p "more " "") + modtagname)))) + (if erlang-tags-file-list + (let ((this-module (erlang-get-module-from-file-name + (car erlang-tags-file-list)))) + (if (and (stringp this-module) + (string= modname this-module)) + (setq file (car erlang-tags-file-list))) + (setq erlang-tags-file-list (cdr erlang-tags-file-list))))) + (set-buffer (or (get-file-buffer file) + (find-file-noselect file))))) + + ((string-match ":" modtagname) + (if (boundp 'find-tag-tag-order) + ;; Method one: Add module-recognising functions to the + ;; list of order functions. However, the tags system + ;; from Emacs 18, and derives thereof (read: XEmacs) + ;; hasn't got this feature. + (progn + (erlang-tags-install-module-check) + (unwind-protect + (funcall (symbol-function 'find-tag) + modtagname next-p regexp-p) + (erlang-tags-remove-module-check))) + ;; Method two: Call the tags system until a file matching + ;; the module is found. This could result in that many + ;; files are read. (e.g. The tag "foo:file" will take a + ;; while to process.) + (let* ((modname (substring modtagname 0 (match-beginning 0))) + (tagname (substring modtagname (match-end 0) nil)) + (last-tag tagname) + file) + (while + (progn + (funcall (symbol-function 'find-tag) tagname next-p regexp-p) + (setq next-p t) + ;; Determine the module form the file name. (The + ;; alternative, to check `-module', would make this + ;; code useless for non-Erlang programs.) + (setq file (erlang-get-module-from-file-name buffer-file-name)) + (not (and (stringp file) + (string= modname file)))))))) + (t + (funcall (symbol-function 'find-tag) modtagname next-p regexp-p))) + (current-buffer))) ; Return the new buffer. + + +;; Process interactive arguments for erlang-find-tag-*. +;; +;; Negative arguments work only for `etags', not `tags'. This is not +;; a problem since negative arguments means step back into the +;; history list, a feature not implemented in `tags'. + +(defun erlang-tag-interactive (prompt) + (condition-case nil + (require 'etags) + (error + (require 'tags))) + (if current-prefix-arg + (list nil (if (< (prefix-numeric-value current-prefix-arg) 0) + '- + t)) + (let* ((default (erlang-find-tag-default)) + (prompt (if default + (format "%s(default %s) " prompt default) + prompt)) + (spec (if (featurep 'etags) + (completing-read prompt 'erlang-tags-complete-tag) + (read-string prompt)))) + (list (if (equal spec "") + (or default (error "There is no default tag")) + spec))))) + + +;; Search tag functions which are aware of Erlang modules. The tactic +;; is to store new search functions into the local variables of the +;; TAGS buffers. The variables are restored directly after the +;; search. The situation is complicated by the fact that new TAGS +;; files can be loaded during the search. +;; + +(defun erlang-tags-install-module-check () + "Install our own tag search functions." + ;; Make sure our functions are installed in TAGS files loaded + ;; into Emacs while searching. + (cond + ((>= erlang-emacs-major-version 20) + (setq erlang-tags-orig-format-functions + (symbol-value 'tags-table-format-functions)) + (funcall (symbol-function 'set) 'tags-table-format-functions + (cons 'erlang-tags-recognize-tags-table + erlang-tags-orig-format-functions)) + (setq erlang-tags-buffer-list '()) + ) + (t + (setq erlang-tags-orig-format-hooks + (symbol-value 'tags-table-format-hooks)) + (funcall (symbol-function 'set) 'tags-table-format-hooks + (cons 'erlang-tags-recognize-tags-table + erlang-tags-orig-format-hooks)) + (setq erlang-tags-buffer-list '()) + )) + + ;; Install our functions in the TAGS files already resident. + (save-excursion + (let ((files (symbol-value 'tags-table-computed-list))) + (while files + (if (stringp (car files)) + (if (get-file-buffer (car files)) + (progn + (set-buffer (get-file-buffer (car files))) + (erlang-tags-install-local)))) + (setq files (cdr files)))))) + + +(defun erlang-tags-install-local () + "Install our tag search functions in current buffer." + (if erlang-tags-buffer-installed-p + () + ;; Mark this buffer as "installed" and record. + (set (make-local-variable 'erlang-tags-buffer-installed-p) t) + (setq erlang-tags-buffer-list + (cons (current-buffer) erlang-tags-buffer-list)) + + ;; Save the original values. + (set (make-local-variable 'erlang-tags-orig-tag-order) + (symbol-value 'find-tag-tag-order)) + (set (make-local-variable 'erlang-tags-orig-regexp-tag-order) + (symbol-value 'find-tag-regexp-tag-order)) + (set (make-local-variable 'erlang-tags-orig-search-function) + (symbol-value 'find-tag-search-function)) + (set (make-local-variable 'erlang-tags-orig-regexp-search-function) + (symbol-value 'find-tag-regexp-search-function)) + + ;; Install our own functions. + (set (make-local-variable 'find-tag-search-function) + 'erlang-tags-search-forward) + (set (make-local-variable 'find-tag-regexp-search-function) + 'erlang-tags-regexp-search-forward) + (set (make-local-variable 'find-tag-tag-order) + '(erlang-tag-match-module-p)) + (set (make-local-variable 'find-tag-regexp-tag-order) + '(erlang-tag-match-module-regexp-p)))) + + +(defun erlang-tags-remove-module-check () + "Remove our own tags search functions." + (cond + ((>= erlang-emacs-major-version 20) + (funcall (symbol-function 'set) + 'tags-table-format-functions + erlang-tags-orig-format-functions) + ) + (t + (funcall (symbol-function 'set) + 'tags-table-format-hooks + erlang-tags-orig-format-hooks) + )) + + ;; Remove our functions from the TAGS files. (Note that + ;; `tags-table-computed-list' need not be the same list as when + ;; the search was started.) + (save-excursion + (let ((buffers erlang-tags-buffer-list)) + (while buffers + (if (buffer-name (car buffers)) + (progn + (set-buffer (car buffers)) + (erlang-tags-remove-local))) + (setq buffers (cdr buffers)))))) + + +(defun erlang-tags-remove-local () + "Remove our tag search functions from current buffer." + (if (null erlang-tags-buffer-installed-p) + () + (funcall (symbol-function 'set) 'erlang-tags-buffer-installed-p nil) + (funcall (symbol-function 'set) + 'find-tag-tag-order erlang-tags-orig-tag-order) + (funcall (symbol-function 'set) + 'find-tag-regexp-tag-order erlang-tags-orig-regexp-tag-order) + (funcall (symbol-function 'set) + 'find-tag-search-function erlang-tags-orig-search-function) + (funcall (symbol-function 'set) + 'find-tag-regexp-search-function + erlang-tags-orig-regexp-search-function))) + + +(defun erlang-tags-recognize-tags-table () + "Install our functions in all loaded TAGS files. + +This function is added to `tags-table-format-hooks/functions' when searching +for a tag on the form `module:tag'." + (if (null (funcall (symbol-function 'etags-recognize-tags-table))) + nil + (erlang-tags-install-local) + t)) + + +(defun erlang-tags-search-forward (tag &optional bound noerror count) + "Forward search function, aware of Erlang module prefix." + (if (string-match ":" tag) + (setq tag (substring tag (match-end 0) nil))) + ;; Avoid unintended recursion. + (if (eq erlang-tags-orig-search-function 'erlang-tags-search-forward) + (search-forward tag bound noerror count) + (funcall erlang-tags-orig-search-function tag bound noerror count))) + + +(defun erlang-tags-regexp-search-forward (tag &optional bound noerror count) + "Forward regexp search function, aware of Erlang module prefix." + (if (string-match ":" tag) + (setq tag (substring tag (match-end 0) nil))) + (if (eq erlang-tags-orig-regexp-search-function + 'erlang-tags-regexp-search-forward) + (re-search-forward tag bound noerror count) + (funcall erlang-tags-orig-regexp-search-function + tag bound noerror count))) + + +;; t if point is at a tag line that matches TAG, containing +;; module information. Assumes that all other order functions +;; are stored in `erlang-tags-orig-[regex]-tag-order'. + +(defun erlang-tag-match-module-p (tag) + (erlang-tag-match-module-common-p tag erlang-tags-orig-tag-order)) + +(defun erlang-tag-match-module-regexp-p (tag) + (erlang-tag-match-module-common-p tag erlang-tags-orig-regexp-tag-order)) + +(defun erlang-tag-match-module-common-p (tag order) + (let ((mod nil) + (found nil)) + (if (string-match ":" tag) + (progn + (setq mod (substring tag 0 (match-beginning 0))) + (setq tag (substring tag (match-end 0) nil)))) + (while (and order (not found)) + (setq found + (and (not (memq (car order) + '(erlang-tag-match-module-p + erlang-tag-match-module-regexp-p))) + (funcall (car order) tag))) + (setq order (cdr order))) + (and found + (or (null mod) + (string= mod (erlang-get-module-from-file-name + (file-of-tag))))))) + + +;;; Tags completion, Emacs 19 `etags' specific. +;;; +;;; The basic idea is to create a second completion table `erlang-tags- +;;; completion-table' containing all normal tags plus tags on the form +;;; `module:tag'. + + +(defun erlang-complete-tag () + "Perform tags completion on the text around point. +Completes to the set of names listed in the current tags table. + +Should the Erlang tags system be installed this command knows +about Erlang modules." + (interactive) + (condition-case nil + (require 'etags) + (error nil)) + (cond ((and erlang-tags-installed + (fboundp 'complete-tag)) ; Emacs 19 + (let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag))) + (fset 'tags-complete-tag + (symbol-function 'erlang-tags-complete-tag)) + (unwind-protect + (funcall (symbol-function 'complete-tag)) + (fset 'tags-complete-tag orig-tags-complete-tag)))) + ((fboundp 'complete-tag) ; Emacs 19 + (funcall (symbol-function 'complete-tag))) + ((fboundp 'tag-complete-symbol) ; XEmacs + (funcall (symbol-function 'tag-complete-symbol))) + (t + (error "This version of Emacs can't complete tags")))) + + +;; Based on `tags-complete-tag', but this one uses +;; `erlang-tags-completion-table' instead of `tags-completion-table'. +;; +;; This is the entry-point called by system function `completing-read'. +(defun erlang-tags-complete-tag (string predicate what) + (save-excursion + ;; If we need to ask for the tag table, allow that. + (let ((enable-recursive-minibuffers t)) + (visit-tags-table-buffer)) + (if (eq what t) + (all-completions string (erlang-tags-completion-table) predicate) + (try-completion string (erlang-tags-completion-table) predicate)))) + + +;; `tags-completion-table' calls itself recursively, make it +;; call our own wedge instead. Note that the recursive call +;; is very rare; it only occurs when a tags-file contains +;; `include'-statements. +(defun erlang-tags-completion-table () + "Build completion table. Tags on the form `tag' or `module:tag'." + (setq erlang-tags-orig-completion-table + (symbol-function 'tags-completion-table)) + (fset 'tags-completion-table + (symbol-function 'erlang-tags-completion-table-1)) + (unwind-protect + (erlang-tags-completion-table-1) + (fset 'tags-completion-table + erlang-tags-orig-completion-table))) + + +(defun erlang-tags-completion-table-1 () + (make-local-variable 'erlang-tags-completion-table) + (or erlang-tags-completion-table + (let ((tags-completion-table nil) + (tags-completion-table-function + 'erlang-etags-tags-completion-table)) + (funcall erlang-tags-orig-completion-table) + (setq erlang-tags-completion-table tags-completion-table)))) + + +;; Based on `etags-tags-completion-table'. The difference is that we +;; add three symbols to the vector, the tag, module: and module:tag. +;; The module is extracted from the file name of a tag. (This one +;; only works if we are looking at an `etags' file. However, this is +;; the only format supported by Emacs, so far.) +(defun erlang-etags-tags-completion-table () + (let ((table (make-vector 511 0)) + (file nil)) + (save-excursion + (goto-char (point-min)) + ;; This monster regexp matches an etags tag line. + ;; \1 is the string to match; + ;; \2 is not interesting; + ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN + ;; \4 is not interesting; + ;; \5 is the explicitly-specified tag name. + ;; \6 is the line to start searching at; + ;; \7 is the char to start searching at. + (while (progn + (while (and + (eq (following-char) ?\f) + (looking-at "\f\n\\([^,\n]*\\),.*\n")) + (setq file (buffer-substring + (match-beginning 1) (match-end 1))) + (goto-char (match-end 0))) + (re-search-forward + "\ +^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\ +\[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\ +\\([0-9]+\\)?,\\([0-9]+\\)?\n" + nil t)) + (let ((tag (if (match-beginning 5) + ;; There is an explicit tag name. + (buffer-substring (match-beginning 5) (match-end 5)) + ;; No explicit tag name. Best guess. + (buffer-substring (match-beginning 3) (match-end 3)))) + (module (and file + (erlang-get-module-from-file-name file)))) + (intern tag table) + (if (stringp module) + (progn + (intern (concat module ":" tag) table) + ;; Only the first one will be stored in the table. + (intern (concat module ":") table)))))) + table)) + +;;; +;;; Prepare for other methods to run an Erlang slave process. +;;; + +(defvar erlang-shell-function 'inferior-erlang + "Command to execute start a new Erlang shell. + +Change this variable to use your favorite +Erlang compilation package.") + +(defvar erlang-shell-display-function 'inferior-erlang-run-or-select + "Command to execute to display Erlang shell. + +Change this variable to use your favorite +Erlang compilation package.") + +(defvar erlang-compile-function 'inferior-erlang-compile + "Command to execute to compile current buffer. + +Change this variable to use your favorite +Erlang compilation package.") + +(defvar erlang-compile-erlang-function "c" + "Erlang function to call to compile an erlang file.") + +(defvar erlang-compile-display-function 'inferior-erlang-run-or-select + "Command to execute to view last compilation. + +Change this variable to use your favorite +Erlang compilation package.") + +(defvar erlang-next-error-function 'inferior-erlang-next-error + "Command to execute to go to the next error. + +Change this variable to use your favorite Erlang compilation +package. Not used in Emacs 21.") + + +;;;###autoload +(defun erlang-shell () + "Start a new Erlang shell. + +The variable `erlang-shell-function' decides which method to use, +default is to start a new Erlang host. It is possible that, in the +future, a new shell on an already running host will be started." + (interactive) + (call-interactively erlang-shell-function)) + + +;;;###autoload (autoload 'run-erlang "erlang" "Start a new Erlang shell." t) + +;; It is customary for Emacs packages to supply a function on this +;; form, even though it violates the `erlang-*' name convention. +(defalias 'run-erlang 'erlang-shell) + + +(defun erlang-shell-display () + "Display an Erlang shell, or start a new." + (interactive) + (call-interactively erlang-shell-display-function)) + + +;;;###autoload +(defun erlang-compile () + "Compile Erlang module in current buffer." + (interactive) + (call-interactively erlang-compile-function)) + + +(defun erlang-compile-display () + "Display compilation output." + (interactive) + (call-interactively erlang-compile-display-function)) + + +(defun erlang-next-error () + "Display next error message from the latest compilation." + (interactive) + (call-interactively erlang-next-error-function)) + + + +;;; +;;; Erlang Shell Mode -- Major mode used for Erlang shells. +;;; + +;; This mode is designed to be implementation independent, +;; e.g. it does not assume that we are running an inferior +;; Erlang, there exists a lot of other possibilities. + + +(defvar erlang-shell-buffer-name "*erlang*" + "The name of the Erlang link shell buffer.") + +(defvar erlang-shell-mode-map nil + "Keymap used by Erlang shells.") + + +(defvar erlang-shell-mode-hook nil + "*User functions to run when an Erlang shell is started. + +This hook is used to change the behaviour of Erlang mode. It is +normally used by the user to personalise the programming environment. +When used in a site init file, it could be used to customise Erlang +mode for all users on the system. + +The function added to this hook is run every time a new Erlang +shell is started. + +See also `erlang-load-hook', a hook which is run once, when Erlang +mode is loaded, and `erlang-mode-hook' which is run every time a new +Erlang source file is loaded into Emacs.") + + +(defvar erlang-input-ring-file-name "~/.erlang_history" + "*When non-nil, file name used to store Erlang shell history information.") + + +(defun erlang-shell-mode () + "Major mode for interacting with an Erlang shell. + +We assume that we already are in Comint mode. + +The following special commands are available: +\\{erlang-shell-mode-map}" + (interactive) + (setq major-mode 'erlang-shell-mode) + (setq mode-name "Erlang Shell") + (erlang-mode-variables) + (if erlang-shell-mode-map + nil + (setq erlang-shell-mode-map (copy-keymap comint-mode-map)) + (erlang-shell-mode-commands erlang-shell-mode-map)) + (use-local-map erlang-shell-mode-map) + (unless inferior-erlang-use-cmm + ;; This was originally not a marker, but it needs to be, at least + ;; in Emacs 21, and should be backwards-compatible. Otherwise, + ;; would need to test whether compilation-parsing-end is a marker + ;; after requiring `compile'. + (set (make-local-variable 'compilation-parsing-end) (copy-marker 1)) + (set (make-local-variable 'compilation-error-list) nil) + (set (make-local-variable 'compilation-old-error-list) nil)) + ;; Needed when compiling directly from the Erlang shell. + (setq compilation-last-buffer (current-buffer)) + (erlang-add-compilation-alist erlang-error-regexp-alist) + (setq comint-prompt-regexp "^[^>=]*> *") + (setq comint-eol-on-send t) + (setq comint-input-ignoredups t) + (setq comint-scroll-show-maximum-output t) + (setq comint-scroll-to-bottom-on-output t) + ;; In Emacs 19.30, `add-hook' has got a `local' flag, use it. If + ;; the call fails, just call the normal `add-hook'. + (condition-case nil + (progn + (add-hook 'comint-output-filter-functions + 'inferior-erlang-strip-delete nil t) + (add-hook 'comint-output-filter-functions + 'inferior-erlang-strip-ctrl-m nil t)) + (error + (funcall (symbol-function 'make-local-hook) + 'comint-output-filter-functions) ; obsolete as of Emacs 21.1 + (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-delete) + (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-ctrl-m))) + ;; Some older versions of comint don't have an input ring. + (if (fboundp 'comint-read-input-ring) + (progn + (setq comint-input-ring-file-name erlang-input-ring-file-name) + (comint-read-input-ring t) + (make-local-variable 'kill-buffer-hook) + (add-hook 'kill-buffer-hook 'comint-write-input-ring))) + ;; At least in Emacs 21, we need to be in `compilation-minor-mode' + ;; for `next-error' to work. We can avoid it clobbering the shell + ;; keys thus. + (when inferior-erlang-use-cmm + (compilation-minor-mode 1) + (set (make-local-variable 'minor-mode-overriding-map-alist) + `((compilation-minor-mode + . ,(let ((map (make-sparse-keymap))) + ;; It would be useful to put keymap properties on the + ;; error lines so that we could use RET and mouse-2 + ;; on them directly. + (when (boundp 'compilation-skip-threshold) ; new compile.el + (define-key map [mouse-2] #'erlang-mouse-2-command) + (define-key map "\C-m" #'erlang-RET-command)) + (if (boundp 'compilation-menu-map) + (define-key map [menu-bar compilation] + (cons "Errors" compilation-menu-map))) + map))))) + (run-hooks 'erlang-shell-mode-hook)) + + +(defun erlang-mouse-2-command (event) + "Command bound to `mouse-2' in inferior Erlang buffer. +Selects Comint or Compilation mode command as appropriate." + (interactive "e") + (if (save-window-excursion + (save-excursion + (mouse-set-point event) + (consp (get-text-property (line-beginning-position) 'message)))) + (call-interactively (lookup-key compilation-mode-map [mouse-2])) + (call-interactively (lookup-key comint-mode-map [mouse-2])))) + +(defun erlang-RET-command () + "Command bound to `RET' in inferior Erlang buffer. +Selects Comint or Compilation mode command as appropriate." + (interactive) + (if (consp (get-text-property (line-beginning-position) 'message)) + (call-interactively (lookup-key compilation-mode-map "\C-m")) + (call-interactively (lookup-key comint-mode-map "\C-m")))) + +(defun erlang-shell-mode-commands (map) + (define-key map "\M-\t" 'erlang-complete-tag) + (define-key map "\C-a" 'comint-bol) ; Normally the other way around. + (define-key map "\C-c\C-a" 'beginning-of-line) + (define-key map "\C-d" nil) ; Was `comint-delchar-or-maybe-eof' + (define-key map "\M-\C-m" 'compile-goto-error) + (unless inferior-erlang-use-cmm + (define-key map "\C-x`" 'erlang-next-error))) + +;;; +;;; Inferior Erlang -- Run an Erlang shell as a subprocess. +;;; + +(defvar inferior-erlang-display-buffer-any-frame nil + "*When nil, `inferior-erlang-display-buffer' use only selected frame. +When t, all frames are searched. When 'raise, the frame is raised.") + +(defvar inferior-erlang-shell-type 'newshell + "The type of Erlang shell to use. + +When this variable is set to the atom `oldshell', the old shell is used. +When set to `newshell' the new shell is used. Should the variable be +nil, the default shell is used. + +This variable influence the setting of other variables.") + +(defvar inferior-erlang-machine "erl" + "*The name of the Erlang shell.") + +(defvar inferior-erlang-machine-options '() + "*The options used when activating the Erlang shell. + +This must be a list of strings.") + +(defvar inferior-erlang-process-name "inferior-erlang" + "The name of the inferior Erlang process.") + +(defvar inferior-erlang-buffer-name erlang-shell-buffer-name + "The name of the inferior Erlang buffer.") + +(defvar inferior-erlang-prompt-timeout 60 + "*Number of seconds before `inferior-erlang-wait-prompt' timeouts. + +The time specified is waited after every output made by the inferior +Erlang shell. When this variable is t, we assume that we always have +a prompt. When nil, we will wait forever, or until \\[keyboard-quit].") + +(defvar inferior-erlang-process nil + "Process of last invoked inferior Erlang, or nil.") + +(defvar inferior-erlang-buffer nil + "Buffer of last invoked inferior Erlang, or nil.") + +;;;###autoload +(defun inferior-erlang () + "Run an inferior Erlang. + +This is just like running Erlang in a normal shell, except that +an Emacs buffer is used for input and output. +\\ +The command line history can be accessed with \\[comint-previous-input] and \\[comint-next-input]. +The history is saved between sessions. + +Entry to this mode calls the functions in the variables +`comint-mode-hook' and `erlang-shell-mode-hook' with no arguments. + +The following commands imitate the usual Unix interrupt and +editing control characters: +\\{erlang-shell-mode-map}" + (interactive) + (require 'comint) + (let ((opts inferior-erlang-machine-options)) + (cond ((eq inferior-erlang-shell-type 'oldshell) + (setq opts (cons "-oldshell" opts))) + ((eq inferior-erlang-shell-type 'newshell) + (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts)))) + (setq inferior-erlang-buffer + (apply 'make-comint + inferior-erlang-process-name inferior-erlang-machine + nil opts))) + (setq inferior-erlang-process + (get-buffer-process inferior-erlang-buffer)) + (if (> 21 erlang-emacs-major-version) ; funcalls to avoid compiler warnings + (funcall (symbol-function 'set-process-query-on-exit-flag) + inferior-erlang-process nil) + (funcall (symbol-function 'process-kill-without-query) inferior-erlang-process)) + (if erlang-inferior-shell-split-window + (switch-to-buffer-other-window inferior-erlang-buffer) + (switch-to-buffer inferior-erlang-buffer)) + (if (and (not (eq system-type 'windows-nt)) + (eq inferior-erlang-shell-type 'newshell)) + (setq comint-process-echoes t)) + ;; `rename-buffer' takes only one argument in Emacs 18. + (condition-case nil + (rename-buffer inferior-erlang-buffer-name t) + (error (rename-buffer inferior-erlang-buffer-name))) + (erlang-shell-mode)) + + +(defun inferior-erlang-run-or-select () + "Switch to an inferior Erlang buffer, possibly starting new process." + (interactive) + (if (null (inferior-erlang-running-p)) + (inferior-erlang) + (inferior-erlang-display-buffer t))) + + +(defun inferior-erlang-display-buffer (&optional select) + "Make the inferior Erlang process visible. +The window is returned. + +Should `inferior-erlang-display-buffer-any-frame' be nil the buffer is +displayed in the current frame. Should it be non-nil, and the buffer +already is visible in any other frame, no new window will be created. +Should it be the atom 'raise, the frame containing the window will +be raised. + +Should the optional argument SELECT be non-nil, the window is +selected. Should the window be in another frame, that frame is raised. + +Note, should the mouse pointer be places outside the raised frame, that +frame will become deselected before the next command." + (interactive) + (or (inferior-erlang-running-p) + (error "No inferior Erlang process is running")) + (let ((win (inferior-erlang-window + inferior-erlang-display-buffer-any-frame)) + (frames-p (fboundp 'selected-frame))) + (if (null win) + (let ((old-win (selected-window))) + (save-excursion + (switch-to-buffer-other-window inferior-erlang-buffer) + (setq win (selected-window))) + (select-window old-win)) + (if (and window-system + frames-p + (or select + (eq inferior-erlang-display-buffer-any-frame 'raise)) + (not (eq (selected-frame) (window-frame win)))) + (raise-frame (window-frame win)))) + (if select + (select-window win)) + (sit-for 0) + win)) + + +(defun inferior-erlang-running-p () + "Non-nil when an inferior Erlang is running." + (and inferior-erlang-process + (memq (process-status inferior-erlang-process) '(run open)) + inferior-erlang-buffer + (buffer-name inferior-erlang-buffer))) + + +(defun inferior-erlang-window (&optional all-frames) + "Return the window containing the inferior Erlang, or nil." + (and (inferior-erlang-running-p) + (if (and all-frames (>= erlang-emacs-major-version 19)) + (get-buffer-window inferior-erlang-buffer t) + (get-buffer-window inferior-erlang-buffer)))) + + +(defun inferior-erlang-wait-prompt () + "Wait until the inferior Erlang shell prompt appears." + (if (eq inferior-erlang-prompt-timeout t) + () + (or (inferior-erlang-running-p) + (error "No inferior Erlang shell is running")) + (save-excursion + (set-buffer inferior-erlang-buffer) + (let ((msg nil)) + (while (save-excursion + (goto-char (process-mark inferior-erlang-process)) + (forward-line 0) + (not (looking-at comint-prompt-regexp))) + (if msg + () + (setq msg t) + (message "Waiting for Erlang shell prompt (press C-g to abort).")) + (or (accept-process-output inferior-erlang-process + inferior-erlang-prompt-timeout) + (error "No Erlang shell prompt before timeout"))) + (if msg (message "")))))) + +(defun inferior-erlang-send-empty-cmd-unless-already-at-prompt () + "If not already at a prompt, try to send an empty cmd to get a prompt. +The empty command resembles hitting RET. This is useful in some +situations, for instance if a crash or error report from sasl +has been printed after the last prompt." + (save-excursion + (set-buffer inferior-erlang-buffer) + (if (> (point-max) 1) + ;; make sure we get a prompt if buffer contains data + (if (save-excursion + (goto-char (process-mark inferior-erlang-process)) + (forward-line 0) + (not (looking-at comint-prompt-regexp))) + (inferior-erlang-send-command ""))))) + +(autoload 'comint-send-input "comint") + +(defun inferior-erlang-send-command (cmd &optional hist) + "Send command CMD to the inferior Erlang. + +The contents of the current command line (if any) will +be placed at the next prompt. + +If optional second argument is non-nil the command is inserted into +the history list. + +Return the position after the newly inserted command." + (or (inferior-erlang-running-p) + (error "No inferior Erlang process is running")) + (let ((old-buffer (current-buffer)) + (insert-point (marker-position (process-mark inferior-erlang-process))) + (insert-length (if comint-process-echoes + 0 + (1+ (length cmd))))) + (set-buffer inferior-erlang-buffer) + (goto-char insert-point) + (insert cmd) + ;; Strange things happened if `comint-eol-on-send' is declared + ;; in the `let' expression above, but setq:d here. The + ;; `set-buffer' statement obviously makes the buffer local + ;; instance of `comint-eol-on-send' shadow this one. + ;; I'm considering this a bug in Elisp. + ;; + ;; This was previously cautioned against in the Lisp manual. It + ;; has been sorted out in Emacs 21. -- fx + (let ((comint-eol-on-send nil) + (comint-input-filter (if hist comint-input-filter 'ignore))) + (if (and (not erlang-xemacs-p) + (>= emacs-major-version 22)) + (comint-send-input nil t) + (comint-send-input))) + ;; Adjust all windows whose points are incorrect. + (if (null comint-process-echoes) + (walk-windows + (function + (lambda (window) + (if (and (eq (window-buffer window) inferior-erlang-buffer) + (= (window-point window) insert-point)) + (set-window-point window + (+ insert-point insert-length))))) + nil t)) + (set-buffer old-buffer) + (+ insert-point insert-length))) + + +(defun inferior-erlang-strip-delete (&optional s) + "Remove `^H' (delete) and the characters it was supposed to remove." + (interactive) + (if (and (boundp 'comint-last-input-end) + (boundp 'comint-last-output-start)) + (save-excursion + (goto-char + (if (interactive-p) + (symbol-value 'comint-last-input-end) + (symbol-value 'comint-last-output-start))) + (while (progn (skip-chars-forward "^\C-h") + (not (eq (point) (point-max)))) + (delete-char 1) + (or (bolp) + (backward-delete-char 1)))))) + + +;; Basically `comint-strip-ctrl-m', with a few extra checks. +(defun inferior-erlang-strip-ctrl-m (&optional string) + "Strip trailing `^M' characters from the current output group." + (interactive) + (if (and (boundp 'comint-last-input-end) + (boundp 'comint-last-output-start)) + (let ((pmark (process-mark (get-buffer-process (current-buffer))))) + (save-excursion + (goto-char + (if (interactive-p) + (symbol-value 'comint-last-input-end) + (symbol-value 'comint-last-output-start))) + (while (re-search-forward "\r+$" pmark t) + (replace-match "" t t)))))) + + +(defun inferior-erlang-compile (arg) + "Compile the file in the current buffer. + +With prefix arg, compiles for debug. + +Should Erlang return `{error, nofile}' it could not load the object +module after completing the compilation. This is due to a bug in the +compile command `c' when using the option `outdir'. + +There exists two workarounds for this bug: + + 1) Place the directory in the Erlang load path. + + 2) Set the Emacs variable `erlang-compile-use-outdir' to nil. + To do so, place the following line in your `~/.emacs'-file: + (setq erlang-compile-use-outdir nil)" + (interactive "P") + (save-some-buffers) + (inferior-erlang-prepare-for-input) + (let* ((dir (inferior-erlang-compile-outdir)) +;;; (file (file-name-nondirectory (buffer-file-name))) + (noext (substring (buffer-file-name) 0 -4)) + (opts (append (list (cons 'outdir dir)) + (if current-prefix-arg + (list 'debug_info 'export_all)) + erlang-compile-extra-opts)) + end) + (save-excursion + (set-buffer inferior-erlang-buffer) + (compilation-forget-errors)) + (setq end (inferior-erlang-send-command + (inferior-erlang-compute-compile-command noext opts) + nil)) + (sit-for 0) + (inferior-erlang-wait-prompt) + (save-excursion + (set-buffer inferior-erlang-buffer) + (setq compilation-error-list nil) + (set-marker compilation-parsing-end end)) + (setq compilation-last-buffer inferior-erlang-buffer))) + +(defun inferior-erlang-prepare-for-input (&optional no-display) + "Create an inferior erlang buffer if needed and ready it for input. +The buffer is displayed, according to `inferior-erlang-display-buffer' +unless the optional NO-DISPLAY is non-nil." + (or (inferior-erlang-running-p) + (save-excursion + (inferior-erlang))) + (or (inferior-erlang-running-p) + (error "Error starting inferior Erlang shell")) + (if (not no-display) + (inferior-erlang-display-buffer)) + (inferior-erlang-send-empty-cmd-unless-already-at-prompt) + (sit-for 0) + (inferior-erlang-wait-prompt)) + +(defun inferior-erlang-compile-outdir () + "Return the directory to compile the current buffer into." + (let* ((buffer-dir (directory-file-name + (file-name-directory (buffer-file-name)))) + (parent-dir (directory-file-name + (file-name-directory buffer-dir))) + (ebin-dir (concat (file-name-as-directory parent-dir) "ebin")) + (buffer-dir-base-name (file-name-nondirectory + (expand-file-name + (concat (file-name-as-directory buffer-dir) + "."))))) + (if (and (string= buffer-dir-base-name "src") + (file-directory-p ebin-dir)) + (file-name-as-directory ebin-dir) + (file-name-as-directory buffer-dir)))) + +(defun inferior-erlang-compute-compile-command (module-name opts) + (let* ((out-dir-opt (assoc 'outdir opts)) + (out-dir (cdr out-dir-opt))) + (if erlang-compile-use-outdir + (format "%s(\"%s\"%s)." + erlang-compile-erlang-function + module-name + (inferior-erlang-format-comma-opts opts)) + (let (;; Hopefully, noone else will ever use these... + (tmpvar "Tmp7236") + (tmpvar2 "Tmp8742")) + (format + (concat + "f(%s), {ok, %s} = file:get_cwd(), " + "file:set_cwd(\"%s\"), " + "%s = %s(\"%s\"%s), file:set_cwd(%s), f(%s), %s.") + tmpvar2 tmpvar + out-dir + tmpvar2 + erlang-compile-erlang-function + module-name (inferior-erlang-format-comma-opts + (remq out-dir-opt opts)) + tmpvar tmpvar tmpvar2))))) + +(defun inferior-erlang-format-comma-opts (opts) + (if (null opts) + "" + (concat ", " (inferior-erlang-format-opts opts)))) + +(defun inferior-erlang-format-opts (opts) + (concat "[" (inferior-erlang-string-join (mapcar 'inferior-erlang-format-opt + opts) + ", ") + "]")) + +(defun inferior-erlang-format-opt (opt) + (cond ((stringp opt) (concat "\"" opt "\"")) + ((atom opt) (format "%s" opt)) + ((consp opt) (concat "{" (inferior-erlang-string-join + (mapcar 'inferior-erlang-format-opt + (list (car opt) (cdr opt))) + ", ") + "}")) + (t (error (format "Unexpected opt %s" opt))))) + +(defun inferior-erlang-string-join (strs sep) + (let ((result (or (car strs) ""))) + (setq strs (cdr strs)) + (while strs + (setq result (concat result sep (car strs))) + (setq strs (cdr strs))) + result)) + +;; `next-error' only accepts buffers with major mode `compilation-mode' +;; or with the minor mode `compilation-minor-mode' activated. +;; (To activate the minor mode is out of the question, since it will +;; ruin the inferior Erlang keymap.) +;; This is done differently in Emacs 21. +(defun inferior-erlang-next-error (&optional argp) + "Just like `next-error'. +Capable of finding error messages in an inferior Erlang buffer." + (interactive "P") + (let ((done nil) + (buf (or (and (boundp 'next-error-last-buffer) + next-error-last-buffer) + (and (boundp 'compilation-last-buffer) + compilation-last-buffer)))) + (if (and (bufferp buf) + (save-excursion + (set-buffer buf) + (and (eq major-mode 'erlang-shell-mode) + (setq major-mode 'compilation-mode)))) + (unwind-protect + (progn + (setq done t) + (next-error argp)) + (save-excursion + (set-buffer buf) + (setq major-mode 'erlang-shell-mode)))) + (or done + (next-error argp)))) + + +(defun inferior-erlang-change-directory (&optional dir) + "Make the inferior Erlang change directory. +The default is to go to the directory of the current buffer." + (interactive) + (or dir (setq dir (file-name-directory (buffer-file-name)))) + (or (inferior-erlang-running-p) + (error "No inferior Erlang is running")) + (inferior-erlang-display-buffer) + (inferior-erlang-send-empty-cmd-unless-already-at-prompt) + (inferior-erlang-wait-prompt) + (inferior-erlang-send-command (format "cd('%s')." dir) nil)) + +(defun erlang-align-arrows (start end) + "Align arrows (\"->\") in function clauses from START to END. +When called interactively, aligns arrows after function clauses inside +the region. + +With a prefix argument, aligns all arrows, not just those in function +clauses. + +Example: + +sum(L) -> sum(L, 0). +sum([H|T], Sum) -> sum(T, Sum + H); +sum([], Sum) -> Sum. + +becomes: + +sum(L) -> sum(L, 0). +sum([H|T], Sum) -> sum(T, Sum + H); +sum([], Sum) -> Sum." + (interactive "r") + (save-excursion + (let (;; regexp for matching arrows. without a prefix argument, + ;; the regexp matches function heads. With a prefix, it + ;; matches any arrow. + (re (if current-prefix-arg + "^.*\\(\\)->" + (eval-when-compile + (concat "^" erlang-atom-regexp ".*\\(\\)->")))) + ;; part of regexp matching directly before the arrow + (arrow-match-pos (if current-prefix-arg + 1 + (1+ erlang-atom-regexp-matches))) + ;; accumulator for positions where arrows are found, ordered + ;; by buffer position (from greatest to smallest) + (arrow-positions '()) + ;; accumulator for longest distance from start of line to arrow + (most-indent 0) + ;; marker to track the end of the region we're aligning + (end-marker (progn (goto-char end) + (point-marker)))) + ;; Pass 1: Find the arrow positions, adjust the whitespace + ;; before each arrow to one space, and find the greatest + ;; indentation level. + (goto-char start) + (while (re-search-forward re end-marker t) + (goto-char (match-beginning arrow-match-pos)) + (just-one-space) ; adjust whitespace + (setq arrow-positions (cons (point) arrow-positions)) + (setq most-indent (max most-indent (erlang-column-number)))) + (set-marker end-marker nil) ; free the marker + ;; Pass 2: Insert extra padding so that all arrow indentation is + ;; equal. This is done last-to-first by buffer position, so that + ;; inserting spaces before one arrow doesn't change the + ;; positions of the next ones. + (mapc (lambda (arrow-pos) + (goto-char arrow-pos) + (let* ((pad (- most-indent (erlang-column-number)))) + (when (> pad 0) + (insert-char ?\ pad)))) + arrow-positions)))) + +(defun erlang-column-number () + "Return the column number of the current position in the buffer. +Tab characters are counted by their visual width." + (string-width (buffer-substring (line-beginning-position) (point)))) + +(defun erlang-current-defun () + "`add-log-current-defun-function' for Erlang." + (save-excursion + (erlang-beginning-of-function) + (if (looking-at "[a-z0-9_]+") + (match-string 0)))) + +;; Aliases for backward compatibility with older versions of Erlang Mode. +;; +;; Unfortuantely, older versions of Emacs doesn't have `defalias' and +;; `make-obsolete' so we have to define our own `obsolete' function. + +(defun erlang-obsolete (sym newdef) + "Make the obsolete function SYM refer to the defined function NEWDEF. + +Simplified version of a combination `defalias' and `make-obsolete', +it assumes that NEWDEF is loaded." + (defalias sym (symbol-function newdef)) + (if (fboundp 'make-obsolete) + (make-obsolete sym newdef))) + + +(erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent) +(erlang-obsolete 'calculate-erlang-stack-indent + 'erlang-calculate-stack-indent) +(erlang-obsolete 'at-erlang-keyword 'erlang-at-keyword) +(erlang-obsolete 'at-erlang-operator 'erlang-at-operator) +(erlang-obsolete 'beginning-of-erlang-clause 'erlang-beginning-of-clause) +(erlang-obsolete 'end-of-erlang-clause 'erlang-end-of-clause) +(erlang-obsolete 'mark-erlang-clause 'erlang-mark-clause) +(erlang-obsolete 'beginning-of-erlang-function 'erlang-beginning-of-function) +(erlang-obsolete 'end-of-erlang-function 'erlang-end-of-function) +(erlang-obsolete 'mark-erlang-function 'erlang-mark-function) +(erlang-obsolete 'pass-over-erlang-clause 'erlang-pass-over-function) +(erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function) + + +;; Fixme: shouldn't redefine `set-visited-file-name' anyhow -- see above. +(defconst erlang-unload-hook + (list (lambda () + (defalias 'set-visited-file-name + 'erlang-orig-set-visited-file-name) + (when (featurep 'advice) + (ad-unadvise 'Man-notify-when-ready) + (ad-unadvise 'set-visited-file-name))))) + + +(defun erlang-string-to-int (string) + (if (fboundp 'string-to-number) + (string-to-number string) + (funcall (symbol-function 'string-to-int) string))) + +;; The end... + +(provide 'erlang) + +(run-hooks 'erlang-load-hook) + +;; Local variables: +;; coding: iso-8859-1 +;; End: + +;;; erlang.el ends here diff --git a/lib/tools/emacs/erlang_appwiz.el b/lib/tools/emacs/erlang_appwiz.el new file mode 100644 index 0000000000..ecbce66f47 --- /dev/null +++ b/lib/tools/emacs/erlang_appwiz.el @@ -0,0 +1,1345 @@ +;;; -*- Emacs-Lisp -*- +;;; File: erlang_appwiz.el +;;; Author: Johan Bevermyr +;;; Created: Tue Dec 9 13:14:24 1997 +;;; Purpose: Adds a simple application wizard to erlang.el. + +;; OBS! Must be loaded before the erlang.el file is loaded. +;; Add the following to your .emacs file before erlang.el is loaded. +;; +;; (load "erlang_appwiz" t nil) +;; +;; Customisation of makefile generation: +;; +;; The templates for generating makefiles are stored in the +;; variables erlang-skel-makefile-src and erlang-skel-makefile-middle. +;; +;; These can be modified by setting the variables before or after this +;; file is loaded. +;; +;; For example, to generate OTP-style make files: +;; +;; +;;(defvar erlang-skel-makefile-src +;; '((erlang-skel-include erlang-skel-nomodule-header) +;; "CC_ROOT := $(shell pwd | sed 's/erts.*$$//')" n +;; "AUTOCONF := $(CC_ROOT)/erts/autoconf" n +;; "TARGET := $(shell $(AUTOCONF)/config.guess)" +;; "include $(CC_ROOT)/internal_tools/make/$(TARGET)/otp.mk" n +;; n +;; "# ----------------------------------------------------" n +;; "# Application version " n +;; "# ----------------------------------------------------" n +;; "include ../vsn.mk" n +;; "VSN=$(KERNEL_VSN)" n +;; n +;; "# ----------------------------------------------------" n +;; "# Release directory specification" n +;; "# ----------------------------------------------------" n +;; "RELEASE_PATH= ../../../release/$(TARGET)" n +;; "RELSYSDIR = $(RELEASE_PATH)/lib/kernel-$(VSN)" n +;; n +;; "# ----------------------------------------------------" n +;; "# Target Specs" n +;; "# ----------------------------------------------------" n +;; n +;; "MODULES= " appwiz-erlang-modulename n +;; n +;; "HRL_FILES=" +;; n +;; INTERNAL_HRL_FILES= appwiz-erlang-modulename "_sup.hrl" n +;; n +;; "ERL_FILES= $(MODULES:%=%.erl)" n +;; n +;; "TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET)" n +;; n +;; "APP_FILE= " appwiz-erlang-modulename ".app" n +;; n +;; "APP_SRC= $(APP_FILE).src" n +;; "APP_TARGET= ../ebin/$(APP_FILE)" n +;; n +;; "# ----------------------------------------------------" n +;; "# FLAGS " n +;; "# ----------------------------------------------------" n +;; "ERL_FLAGS += " n +;; "ERL_COMPILE_FLAGS += -I../include" n +;; n +;; "# ----------------------------------------------------" n +;; "# Targets" n +;; "# ----------------------------------------------------" n +;; n +;; "debug opt: $(TARGET_FILES)" n +;; n +;; "clean:" n +;; " rm -f $(TARGET_FILES) $(GEN_FILES)" n +;; " rm -f core" n +;; n +;; "docs:" n +;; n +;; "# ----------------------------------------------------" n +;; "# Special Build Targets " n +;; "# ----------------------------------------------------" n +;; " " n +;; "$(APP_TARGET): $(APP_SRC) " n +;; " sed -e 's;%VSN%;$(VSN);' $(APP_SRC) > $(APP_TARGET)" n +;; " " n +;; "# ----------------------------------------------------" n +;; "# Release Target " n +;; "# ----------------------------------------------------" n +;; "include $(CC_ROOT)/internal_tools/make/otp_release_targets.mk" n +;; n +;; "release_spec: opt" n +;; " $(INSTALL_DIR) $(RELSYSDIR)/src " n +;; " $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src " n +;; " $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src " n +;; " $(INSTALL_DIR) $(RELSYSDIR)/include " n +;; " $(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include " n +;; " $(INSTALL_DIR) $(RELSYSDIR)/ebin " n +;; " $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin " n +;; n +;; "release_docs_spec:" n +;; )) +;; +;; +;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Erlang application wizard +;; + +(defun erlang-application-wizard (directory name) + "Creates all files and directories needed for an application. +The top-level directory is placed in DIRECTORY. NAME is used when +creating the root directory and for naming application files." + + (interactive "DApplication root directory: \nsName of application: ") + (let ((dir nil) + (lastchar (substring directory (- (length directory) 1))) + (apptype (completing-read "Type of application: " + '(("gen_server" 1) + ("gen_event" 2) + ("gen_fsm" 3) + ("other" 4)) + nil t "gen_server")) + (appname nil) + (apptemplate nil) + (apitemplate nil) + (extension nil)) + + (if (string= lastchar "/") + (setq dir directory) + (setq dir (concat directory "/"))) + + ;; determine type of application + (cond ((string= apptype "gen_server") + (setq extension "_server") + (setq appname (concat name extension)) + (setq apptemplate 'tempo-template-erlang-generic-server) + (setq apitemplate 'tempo-template-erlang-large-header)) + ((string= apptype "gen_event") + (setq extension "_event") + (setq appname (concat name extension)) + (setq apptemplate 'tempo-template-erlang-gen-event) + (setq apitemplate 'tempo-template-erlang-large-header)) + ((string= apptype "gen_fsm") + (setq extension "_fsm") + (setq appname (concat name extension)) + (setq apptemplate 'tempo-template-erlang-gen-fsm) + (setq apitemplate 'tempo-template-large-header)) + (t + ;; use defaults _work + (setq extension "_work") + (setq appname (concat name extension)) + (setq apptemplate 'tempo-template-erlang-large-header) + (setq apitemplate 'tempo-template-erlang-large-header))) + + (setq appwiz-erlang-modulename appname) + (setq appwiz-erlang-ext extension) + + ;; create directories + (make-directory (concat dir name "/" "src") t) + (make-directory (concat dir name "/" "ebin") t) + (make-directory (concat dir name "/" "include") t) + + ;; create directory content + ;;;;;;;;; .erl + (find-file (concat dir name "/" "src/" name ".erl")) + (funcall apitemplate) + (insert "API module for the application " name ".") + (save-buffer) + + ;;;;;;;;; _app.erl + (find-file (concat dir name "/" "src/" name "_app.erl")) + (tempo-template-erlang-application) + (insert "Application callback module for the application " name ".") + + (let ((quotedname (erlang-add-quotes-if-needed + (concat name "_sup"))) + (start (point))) + (while (search-forward "'TopSupervisor':start_link" nil t) + (replace-match (concat quotedname ":start_link") nil t)) + (goto-char start)) + + (save-buffer) + + ;;;;;;;;; _sup.erl + (find-file (concat dir name "/" "src/" name "_sup.erl")) + (tempo-template-erlang-supervisor) + (insert "Top level supervisor for the application " name ".") + + + (let ((quotedname (erlang-add-quotes-if-needed appname)) + (start (point))) + (while (search-forward "'AName'" nil t) + (replace-match quotedname nil t)) + (goto-char start)) + + (let ((quotedname (erlang-add-quotes-if-needed appname)) + (start (point))) + (goto-char 0) + (while (search-forward "'AMODULE'" nil t) + (replace-match quotedname nil t)) + (goto-char start)) + + (save-buffer) + + ;;;;;;;;; _sup.hrl + (find-file (concat dir name "/" "src/" name "_sup.hrl")) + (tempo-template-erlang-nomodule-header) + (save-buffer) + + ;;;;;;;;; _(application).erl + (find-file (concat dir name "/" "src/" appname ".erl")) + (funcall apptemplate) + (save-buffer) + + ;;;;;;;;; makefile (src) + (find-file (concat dir name "/" "src/makefile")) + (setq appwiz-erlang-modulename name) + (setq appwiz-erlang-ext extension) + (tempo-template-erlang-makefile-src) + (insert "Makefile for application " name ".") + (let ((start (point))) + (goto-char 0) + (while (search-forward "%" nil t) + (replace-match "#" nil t)) + (goto-char start)) + (save-buffer) + + ;;;;;;;;; makefile (middle) + (find-file (concat dir name "/" "makefile")) + (tempo-template-erlang-makefile-middle) + (insert "Makefile for application " name ".") + (let ((start (point))) + (goto-char 0) + (while (search-forward "%" nil t) + (replace-match "#" nil t)) + (goto-char start)) + (save-buffer) + + ;;;;;;;;; .app + (find-file (concat dir name "/" "ebin/" name ".app")) + (erlang-mode) + (tempo-template-erlang-app) + (insert "Application specification file for " name ".") + (save-buffer))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; These are setq:ed +;; + +(defvar appwiz-erlang-modulename "foo") +(defvar appwiz-erlang-ext "_work") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Skeletons. +;; Skeletons for nomodule header and .app file added by JB. +;; + +(defvar erlang-skel + '(("If" "if" erlang-skel-if) + ("Case" "case" erlang-skel-case) + ("Receive" "receive" erlang-skel-receive) + ("Receive After" "after" erlang-skel-receive-after) + ("Receive Loop" "loop" erlang-skel-receive-loop) + ("Module" "module" erlang-skel-module) + ("Author" "author" erlang-skel-author) + ("Query" "query" erlang-skel-query) + () + ("Small Header" "small-header" + erlang-skel-small-header erlang-skel-header) + ("Normal Header" "normal-header" + erlang-skel-normal-header erlang-skel-header) + ("Large Header" "large-header" + erlang-skel-large-header erlang-skel-header) + ("No Moudle Header" "nomodule-header" + erlang-skel-nomodule-header erlang-skel-header) + () + ("Small Server" "small-server" + erlang-skel-small-server erlang-skel-header) + () + ("application" "application" + erlang-skel-application erlang-skel-header) + ("app" "app" + erlang-skel-app erlang-skel-header) + ("supervisor" "supervisor" + erlang-skel-supervisor erlang-skel-header) + ("supervisor_bridge" "supervisor-bridge" + erlang-skel-supervisor-bridge erlang-skel-header) + ("gen_server" "generic-server" + erlang-skel-generic-server erlang-skel-header) + ("gen_event" "gen-event" + erlang-skel-gen-event erlang-skel-header) + ("gen_fsm" "gen-fsm" + erlang-skel-gen-fsm erlang-skel-header)) + "*Description of all skeletons templates. +Both functions and menu entries will be created. + +Each entry in `erlang-skel' should be a list with three or four +elements, or the empty list. + +The first element is the name which shows up in the menu. The second +is the `tempo' identfier (The string \"erlang-\" will be added in +front of it). The third is the skeleton descriptor, a variable +containing `tempo' attributes as described in the function +`tempo-define-template'. The optinal fourth elements denotes a +function which should be called when the menu is selected. + +Functions corresponding to every template will be created. The name +of the function will be `tempo-template-erlang-X' where `X' is the +tempo identifier as specified in the second argument of the elements +in this list. + +A list with zero elemets means that the a horisontal line should +be placed in the menu.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Template for .app file skeleton +;; + +(defvar erlang-skel-app + '((erlang-skel-include erlang-skel-nomodule-header) + "{application, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "," n> + "[{description, \"" (erlang-get-module-from-file-name) "\"}," n> + "{vsn, \"0.1\"}," n> + "{modules, [" + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "," n> + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) "_app")) "," n> + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) "_sup")) "," n> + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) appwiz-erlang-ext)) "]}," n> + "{registered, [" + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) appwiz-erlang-ext)) "," + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) "_sup")) "]}," n> + "{applications, [kernel," n> + "stdlib," n> + "sasl," n> + "mnesia]}," n> + "{env, []}," n> + "{mod, {" + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) "_app")) + ", []}}]}." n + ) + "*The template of an application file +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Template for no-module header skeleton. +;; + +(defvar erlang-skel-nomodule-header + '(o (erlang-skel-separator) + (erlang-skel-include erlang-skel-copyright-comment + erlang-skel-file-comment + erlang-skel-author-comment) + "%%% Purpose : " p n + (erlang-skel-include erlang-skel-created-comment) + (erlang-skel-separator) n) + "*The template of a normal header. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; .app extension added. +;; + +(defvar erlang-file-name-extension-regexp "\\.\\(erl\\|hrl\\|app\\)$" + "*Regexp which should match an erlang file name. + +This regexp is used when an Erlang module name is extracted from the +name of an Erlang source file. + +The regexp should only match the section of the file name which should +be excluded from the module name. + +To match all files set this variable to \"\\\\(\\\\..*\\\\|\\\\)$\". +The matches all except the extension. This is useful if the Erlang +tags system should interpretate tags on the form `module:tag' for +files written in other languages than Erlang.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Wizard menu added. +;; + +(defvar erlang-menu-items + '(("Indent" + (("Indent Line" erlang-indent-command) + ("Indent Region " erlang-indent-region + (if erlang-xemacs-p (mark) mark-active)) + ("Indent Clause" erlang-indent-caluse) + ("Indent Function" erlang-indent-function) + ("Indent Buffer" erlang-indent-current-buffer))) + ("Edit" + (("Fill Comment" erlang-fill-paragraph) + ("Comment Region" comment-region + (if erlang-xemacs-p (mark) mark-active)) + ("Uncomment Region" erlang-uncomment-region + (if erlang-xemacs-p (mark) mark-active)) + nil + ("beginning of Function" erlang-beginning-of-function) + ("End of Function" erlang-end-of-function) + ("Mark Function" erlang-mark-function) + nil + ("beginning of Clause" erlang-beginning-of-clause) + ("End of Clause" erlang-end-of-clause) + ("Mark Clause" erlang-mark-clause) + nil + ("New Clause" erlang-generate-new-clause) + ("Clone Arguments" erlang-clone-arguments))) + ("Font Lock Mode" + (("Level 3" erlang-font-lock-level-3) + ("Level 2" erlang-font-lock-level-2) + ("Level 1" erlang-font-lock-level-1) + ("Off" erlang-font-lock-level-0))) + ("TAGS" + (("Find Tag" find-tag) + ("Find Next Tag" erlang-find-next-tag) + ;("Find Regexp" find-tag-regexp) + ("Complete Word" erlang-complete-tag) + ("Tags Apropos" tags-apropos) + ("Search Files" tags-search))) + nil + ("Erlang Shell" inferior-erlang-run-or-select) + ("Compile" erlang-compile) + ("Next Error" inferior-erlang-next-error) + nil + ("Version" erlang-version) + nil + ("Wizards" + (("Application Wizard" erlang-application-wizard)))) + "*Description of menu used in Erlang mode. + +This variable must be a list. The elements are either nil representing +a horisontal line or a list with two or three elements. The first is +the name of the menu item, the second is the function to call, or a +submenu, on the same same form as ITEMS. The third optional argument +is an expression which is evaluated every time the menu is displayed. +Should the expression evaluate to nil the menu item is ghosted. + +Example: + '((\"Func1\" function-one) + (\"SubItem\" + ((\"Yellow\" function-yellow) + (\"Blue\" function-blue))) + nil + (\"Region Funtion\" spook-function midnight-variable)) + +Call the function `erlang-menu-init' after modifying this variable.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Prefixing space removed from date string +;; + +(defun erlang-skel-d-mmm-yyyy () + "Return the current date as a string in \"DD Mon YYYY\" form. +The first character of DD is *not* space if the value is less than 10." + (let ((date (current-time-string))) + (format "%d %s %s" + (string-to-int (substring date 8 10)) + (substring date 4 7) + (substring date -4)))) + +(defvar erlang-skel-date-function 'erlang-skel-d-mmm-yyyy + "*Function which returns date string. +Look in the module `time-stamp' for a battery of functions.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Fixed skeletons. erlang-add-quotes-if-needed introduced where needed. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Server templates. + +(defvar erlang-skel-small-server + '((erlang-skel-include erlang-skel-large-header) + "-export([start/0,init/1])." n n n + "start() ->" n> "spawn(" + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", init, [self()])." n n + "init(From) ->" n> + "loop(From)." n n + "loop(From) ->" n> + "receive" n> + p "_ ->" n> + "loop(From)" n> + "end." + ) + "*Template of a small server. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Behaviour templates. + +(defvar erlang-skel-application + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(application)." n + n + "%% application callbacks" n + "-export([start/2, stop/1])." n n + (erlang-skel-separator) + "%%% Callback functions from application" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: start/2" n + "%% Returns: {ok, Pid} |" n + "%% {ok, Pid, State} |" n + "%% {error, Reason} " n + (erlang-skel-separator 2) + "start(Type, StartArgs) ->" n> + "case 'TopSupervisor':start_link(StartArgs) of" n> + "{ok, Pid} -> " n> + "{ok, Pid};" n> + "Error ->" n> + "Error" n> + "end." n + n + (erlang-skel-separator 2) + "%% Func: stop/1" n + "%% Returns: any "n + (erlang-skel-separator 2) + "stop(State) ->" n> + "ok." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of an application behaviour. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar erlang-skel-supervisor + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor)." n + n + "%% External exports" n + "-export([start_link/1])." n + n + "%% supervisor callbacks" n + "-export([init/1])." n n + (erlang-skel-separator) + "%%% API" n + (erlang-skel-separator) + "start_link(StartArgs) ->" n> + "supervisor:start_link({local, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "}, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", StartArgs)." n + n + (erlang-skel-separator) + "%%% Callback functions from supervisor" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, {SupFlags, [ChildSpec]}} |" n + "%% ignore |" n + "%% {error, Reason} " n + (erlang-skel-separator 2) + "init(StartArgs) ->" n> + "AChild = {'AName',{'AModule',start_link,[]}," n> + "permanent,2000,worker,['AModule']}," n> + "{ok,{{one_for_all,4,3600}, [AChild]}}." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of an supervisor behaviour. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar erlang-skel-supervisor-bridge + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor_bridge)." n + n + "%% External exports" n + "-export([start_link/0])." n + n + "%% supervisor callbacks" n + "-export([init/1, terminate/2])." n n + "-record(state, {})." n + n + (erlang-skel-separator) + "%%% API" n + (erlang-skel-separator) + "start_link() -> " n> + "supervisor_bridge:start_link({local, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "}, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", [])." n + n + (erlang-skel-separator) + "%%% Callback functions from supervisor_bridge" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, Pid, State} |" n + "%% ignore |" n + "%% {error, Reason} " n + (erlang-skel-separator 2) + "init([]) ->" n> + "case 'AModule':start_link() of" n> + "{ok, Pid} ->" n> + "{ok, Pid, #state{}};" n> + "Error ->" n> + "Error" n> + "end." n + n + (erlang-skel-separator 2) + "%% Func: terminate/2" n + "%% Purpose: Synchronized shutdown of the underlying sub system." n + "%% Returns: any" n + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "'AModule':stop()," n> + "ok." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of an supervisor_bridge behaviour. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar erlang-skel-generic-server + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_server)." n + n + "%% External exports" n + "-export([start_link/0])." n + n + "%% gen_server callbacks" n + "-export([init/1, handle_call/3, handle_cast/2, " + "handle_info/2, terminate/2])." n n + "-record(state, {})." n + n + (erlang-skel-separator) + "%%% API" n + (erlang-skel-separator) + "start_link() -> " n> + "gen_server:start_link({local, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "}, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", [], [])." n + n + (erlang-skel-separator) + "%%% Callback functions from gen_server" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, State} |" n + "%% {ok, State, Timeout} |" n + "%% ignore |" n + "%% {stop, Reason}" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Func: handle_call/3" n + "%% Returns: {reply, Reply, State} |" n + "%% {reply, Reply, State, Timeout} |" n + "%% {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, Reply, State} | (terminate/2 is called)" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_call(Request, From, State) ->" n> + "Reply = ok," n> + "{reply, Reply, State}." n + n + (erlang-skel-separator 2) + "%% Func: handle_cast/2" n + "%% Returns: {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_cast(Msg, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Func: handle_info/2" n + "%% Returns: {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_info(Info, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Func: terminate/2" n + "%% Purpose: Shutdown the server" n + "%% Returns: any (ignored by gen_server)" n + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "ok." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of a generic server. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar erlang-skel-gen-event + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_event)." n + n + "%% External exports" n + "-export([start_link/0, add_handler/0])." n + n + "%% gen_event callbacks" n + "-export([init/1, handle_event/2, handle_call/2, " + "handle_info/2, terminate/2])." n n + "-record(state, {})." n + n + (erlang-skel-separator) + "%%% API" n + (erlang-skel-separator) + "start_link() ->" n> + "gen_event:start_link({local, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "}). " n + n + "add_handler() ->" n> + "gen_event:add_handler(" + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) ", " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", [])." n + n + (erlang-skel-separator) + "%%% Callback functions from gen_event" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, State} |" n + "%% Other" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Func: handle_event/2" n + "%% Returns: {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |" n + "%% remove_handler " n + (erlang-skel-separator 2) + "handle_event(Event, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%% Func: handle_call/2" n + "%% Returns: {ok, Reply, State} |" n + "%% {swap_handler, Reply, Args1, State1, Mod2, Args2} |" n + "%% {remove_handler, Reply} " n + (erlang-skel-separator 2) + "handle_call(Request, State) ->" n> + "Reply = ok," n> + "{ok, Reply, State}." n + n + (erlang-skel-separator 2) + "%% Func: handle_info/2" n + "%% Returns: {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |" n + "%% remove_handler " n + (erlang-skel-separator 2) + "handle_info(Info, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%% Func: terminate/2" n + "%% Purpose: Shutdown the server" n + "%% Returns: any" n + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "ok." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of a gen_event. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar erlang-skel-gen-fsm + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_fsm)." n + n + "%% External exports" n + "-export([start_link/0])." n + n + "%% gen_fsm callbacks" n + "-export([init/1, state_name/2, state_name/3, handle_event/3," n> + "handle_sync_event/4, handle_info/3, terminate/3])." n n + "-record(state, {})." n + n + (erlang-skel-separator) + "%%% API" n + (erlang-skel-separator) + "start_link() ->" n> + "gen_fsm:start_link({local, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "}, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", [], [])." n + n + (erlang-skel-separator) + "%%% Callback functions from gen_fsm" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, StateName, StateData} |" n + "%% {ok, StateName, StateData, Timeout} |" n + "%% ignore |" n + "%% {stop, StopReason} " n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, state_name, #state{}}." n + n + (erlang-skel-separator 2) + "%% Func: StateName/2" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} " n + (erlang-skel-separator 2) + "state_name(Event, StateData) ->" n> + "{nextstate, state_name, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: StateName/3" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {reply, Reply, NextStateName, NextStateData} |" n + "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} |" n + "%% {stop, Reason, Reply, NewStateData} " n + (erlang-skel-separator 2) + "state_name(Event, From, StateData) ->" n> + "Reply = ok," n> + "{reply, Reply, state_name, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: handle_event/3" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} " n + (erlang-skel-separator 2) + "handle_event(Event, StateName, StateData) ->" n> + "{nextstate, StateName, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: handle_sync_event/4" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {reply, Reply, NextStateName, NextStateData} |" n + "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} |" n + "%% {stop, Reason, Reply, NewStateData} " n + (erlang-skel-separator 2) + "handle_sync_event(Event, From, StateName, StateData) ->" n> + "Reply = ok," n> + "{reply, Reply, StateName, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: handle_info/3" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} " n + (erlang-skel-separator 2) + "handle_info(Info, StateName, StateData) ->" n> + "{nextstate, StateName, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: terminate/3" n + "%% Purpose: Shutdown the fsm" n + "%% Returns: any" n + (erlang-skel-separator 2) + "terminate(Reason, StateName, StatData) ->" n> + "ok." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of a gen_fsm. +Please see the function `tempo-define-template'.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Original erlang-add-quotes-if-needed is broken, we install a +;; new version. +;; + +(add-hook 'erlang-load-hook 'my-erlang-load-mods) + +(defun fixed-erlang-add-quotes-if-needed (str) + "Return STR, possibly with quotes." + (let ((saved-case-fold-search case-fold-search) + (result nil)) + (setq case-fold-search nil) + (setq result (if (string-match (concat "\\`" erlang-atom-regexp "\\'") str) + str + (concat "'" str "'"))) + (setq case-fold-search saved-case-fold-search) + result)) + +(defun my-erlang-load-mods () + (fset 'erlang-add-quotes-if-needed + (symbol-function 'fixed-erlang-add-quotes-if-needed)) + (appwiz-skel-init)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Additional skeletons which are not shown in the Erlang menu. +;; + +(defvar appwiz-skel + '( +; ("generic-server-no-api" erlang-skel-generic-server-no-api) +; ("generic-server-api" erlang-skel-generic-server-api) +; ("gen-event-no-api" erlang-skel-gen-event-no-api) +; ("gen-event-api" erlang-skel-gen-event-api) +; ("gen-fsm-no-api" erlang-skel-gen-fsm-no-api) +; ("gen-fsm-api" erlang-skel-gen-fsm-api) + ("makefile-middle" erlang-skel-makefile-middle) + ("makefile-src" erlang-skel-makefile-src))) + +(defun appwiz-skel-init () + "Generate the skeleton functions." + (interactive) + (condition-case nil + (require 'tempo) + (error t)) + (if (featurep 'tempo) + (let ((skel appwiz-skel)) + (while skel + (funcall (symbol-function 'tempo-define-template) + (concat "erlang-" (nth 0 (car skel))) + ;; The tempo template used contains an `include' + ;; function call only, hence changes to the + ;; variables describing the templates take effect + ;; immdiately. + (list (list 'erlang-skel-include (nth 1 (car skel)))) + (nth 0 (car skel))) + (setq skel (cdr skel)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; +;; +;;(defvar erlang-skel-generic-server-no-api +;; '((erlang-skel-include erlang-skel-large-header) +;; "-behaviour(gen_server)." n +;; n +;; "%% gen_server callbacks" n +;; "-export([init/1, handle_call/3, handle_cast/2, " +;; "handle_info/2, terminate/2])." n n +;; "-record(state, {})." n +;; n +;; (erlang-skel-separator) +;; "%%% Callback functions from gen_server" n +;; (erlang-skel-separator) +;; n +;; (erlang-skel-separator 2) +;; "%% Func: init/1" n +;; "%% Returns: {ok, State} |" n +;; "%% {ok, State, Timeout} |" n +;; "%% ignore |" n +;; "%% {stop, Reason}" n +;; (erlang-skel-separator 2) +;; "init([]) ->" n> +;; "{ok, #state{}}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_call/3" n +;; "%% Returns: {reply, Reply, State} |" n +;; "%% {reply, Reply, State, Timeout} |" n +;; "%% {noreply, State} |" n +;; "%% {noreply, State, Timeout} |" n +;; "%% {stop, Reason, Reply, State} | (terminate/2 is called)" n +;; "%% {stop, Reason, State} (terminate/2 is called)" n +;; (erlang-skel-separator 2) +;; "handle_call(Request, From, State) ->" n> +;; "Reply = ok," n> +;; "{reply, Reply, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_cast/2" n +;; "%% Returns: {noreply, State} |" n +;; "%% {noreply, State, Timeout} |" n +;; "%% {stop, Reason, State} (terminate/2 is called)" n +;; (erlang-skel-separator 2) +;; "handle_cast(Msg, State) ->" n> +;; "{noreply, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_info/2" n +;; "%% Returns: {noreply, State} |" n +;; "%% {noreply, State, Timeout} |" n +;; "%% {stop, Reason, State} (terminate/2 is called)" n +;; (erlang-skel-separator 2) +;; "handle_info(Info, State) ->" n> +;; "{noreply, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: terminate/2" n +;; "%% Purpose: Shutdown the server" n +;; "%% Returns: any (ignored by gen_server)" n +;; (erlang-skel-separator 2) +;; "terminate(Reason, State) ->" n> +;; "ok." n +;; n +;; (erlang-skel-separator) +;; "%%% Internal functions" n +;; (erlang-skel-separator) +;; ) +;; "*The template of a generic server. +;;Please see the function `tempo-define-template'.") +;; +;;(defvar erlang-skel-generic-server-api +;; '((erlang-skel-include erlang-skel-large-header) +;; "%% External exports" n +;; "-export([start_link/0])." n +;; n +;; (erlang-skel-separator) +;; "%%% API" n +;; (erlang-skel-separator) +;; "start_link() ->" n> +;; "gen_server:start_link({local, " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_server")) "}, " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_server")) ", [], [])." n +;; n +;; )) +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; +;; +;;(defvar erlang-skel-gen-event-no-api +;; '((erlang-skel-include erlang-skel-large-header) +;; "-behaviour(gen_event)." n +;; n +;; "%% gen_event callbacks" n +;; "-export([init/1, handle_event/2, handle_call/2, " +;; "handle_info/2, terminate/2])." n n +;; "-record(state, {})." n +;; n +;; (erlang-skel-separator) +;; "%%% Callback functions from gen_event" n +;; (erlang-skel-separator) +;; n +;; (erlang-skel-separator 2) +;; "%% Func: init/1" n +;; "%% Returns: {ok, State} |" n +;; "%% Other" n +;; (erlang-skel-separator 2) +;; "init([]) ->" n> +;; "{ok, #state{}}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_event/2" n +;; "%% Returns: {ok, State} |" n +;; "%% {swap_handler, Args1, State1, Mod2, Args2} |" n +;; "%% remove_handler " n +;; (erlang-skel-separator 2) +;; "handle_event(Event, State) ->" n> +;; "{ok, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_call/2" n +;; "%% Returns: {ok, Reply, State} |" n +;; "%% {swap_handler, Reply, Args1, State1, Mod2, Args2} |" n +;; "%% {remove_handler, Reply} " n +;; (erlang-skel-separator 2) +;; "handle_call(Request, State) ->" n> +;; "Reply = ok," n> +;; "{ok, Reply, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_info/2" n +;; "%% Returns: {ok, State} |" n +;; "%% {swap_handler, Args1, State1, Mod2, Args2} |" n +;; "%% remove_handler " n +;; (erlang-skel-separator 2) +;; "handle_info(Info, State) ->" n> +;; "{ok, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: terminate/2" n +;; "%% Purpose: Shutdown the server" n +;; "%% Returns: any" n +;; (erlang-skel-separator 2) +;; "terminate(Reason, State) ->" n> +;; "ok." n +;; n +;; (erlang-skel-separator) +;; "%%% Internal functions" n +;; (erlang-skel-separator) +;; ) +;; "*The template of a gen_event. +;;Please see the function `tempo-define-template'.") +;; +;;(defvar erlang-skel-gen-event-api +;; '((erlang-skel-include erlang-skel-large-header) +;; "%% External exports" n +;; "-export([start_link/0, add_handler/0])." n +;; n +;; (erlang-skel-separator) +;; "%%% API" n +;; (erlang-skel-separator) +;; "start_link() ->" n> +;; "gen_event:start_link({local, " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_event")) "}). " n +;; n +;; "add_handler() ->" n> +;; "gen_event:add_handler(" +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_event")) ", " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_event")) ", [])." n +;; n)) +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; +;; +;;(defvar erlang-skel-gen-fsm +;; '((erlang-skel-include erlang-skel-large-header) +;; "-behaviour(gen_fsm)." n +;; n +;; "%% gen_fsm callbacks" n +;; "-export([init/1, state_name/2, state_name/3, handle_event/3," n> +;; "handle_sync_event/4, handle_info/3, terminate/3])." n n +;; "-record(state, {})." n +;; n +;; (erlang-skel-separator) +;; "%%% Callback functions from gen_fsm" n +;; (erlang-skel-separator) +;; n +;; (erlang-skel-separator 2) +;; "%% Func: init/1" n +;; "%% Returns: {ok, StateName, StateData} |" n +;; "%% {ok, StateName, StateData, Timeout} |" n +;; "%% ignore |" n +;; "%% {stop, StopReason} " n +;; (erlang-skel-separator 2) +;; "init([]) ->" n> +;; "{ok, state_name, #state{}}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: StateName/2" n +;; "%% Returns: {next_state, NextStateName, NextStateData} |" n +;; "%% {next_state, NextStateName, NextStateData, Timeout} |" n +;; "%% {stop, Reason, NewStateData} " n +;; (erlang-skel-separator 2) +;; "state_name(Event, StateData) ->" n> +;; "{nextstate, state_name, StateData}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: StateName/3" n +;; "%% Returns: {next_state, NextStateName, NextStateData} |" n +;; "%% {next_state, NextStateName, NextStateData, Timeout} |" n +;; "%% {reply, Reply, NextStateName, NextStateData} |" n +;; "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n +;; "%% {stop, Reason, NewStateData} |" n +;; "%% {stop, Reason, Reply, NewStateData} " n +;; (erlang-skel-separator 2) +;; "state_name(Event, From, StateData) ->" n> +;; "Reply = ok," n> +;; "{reply, Reply, state_name, StateData}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_event/3" n +;; "%% Returns: {next_state, NextStateName, NextStateData} |" n +;; "%% {next_state, NextStateName, NextStateData, Timeout} |" n +;; "%% {stop, Reason, NewStateData} " n +;; (erlang-skel-separator 2) +;; "handle_event(Event, StateName, StateData) ->" n> +;; "{nextstate, StateName, StateData}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_sync_event/4" n +;; "%% Returns: {next_state, NextStateName, NextStateData} |" n +;; "%% {next_state, NextStateName, NextStateData, Timeout} |" n +;; "%% {reply, Reply, NextStateName, NextStateData} |" n +;; "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n +;; "%% {stop, Reason, NewStateData} |" n +;; "%% {stop, Reason, Reply, NewStateData} " n +;; (erlang-skel-separator 2) +;; "handle_sync_event(Event, From, StateName, StateData) ->" n> +;; "Reply = ok," n> +;; "{reply, Reply, StateName, StateData}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_info/3" n +;; "%% Returns: {next_state, NextStateName, NextStateData} |" n +;; "%% {next_state, NextStateName, NextStateData, Timeout} |" n +;; "%% {stop, Reason, NewStateData} " n +;; (erlang-skel-separator 2) +;; "handle_info(Info, StateName, StateData) ->" n> +;; "{nextstate, StateName, StateData}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: terminate/3" n +;; "%% Purpose: Shutdown the fsm" n +;; "%% Returns: any" n +;; (erlang-skel-separator 2) +;; "terminate(Reason, StateName, StatData) ->" n> +;; "ok." n +;; n +;; (erlang-skel-separator) +;; "%%% Internal functions" n +;; (erlang-skel-separator) +;; ) +;; "*The template of a gen_fsm. +;;Please see the function `tempo-define-template'.") +;; +;;(defvar erlang-skel-gen-fsm-no-api +;; '((erlang-skel-include erlang-skel-large-header) +;; "%% External exports" n +;; "-export([start_link/0])." n +;; n +;; (erlang-skel-separator) +;; "%%% API" n +;; (erlang-skel-separator) +;; "start_link() ->" n> +;; "gen_fsm:start_link({local, " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_fsm")) "}, " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_fsm")) ", [], [])." n +;; n +;; )) +;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; requires that the variables appwiz-erlang-modulename and +;; appwiz-erlang-ext are defined. +;; + +(defvar erlang-skel-makefile-src + '((erlang-skel-include erlang-skel-nomodule-header) + "MAKE = make" n + n + "ERL = erlc" n + n + "EBIN = ../ebin" n + n + (erlang-skel-makefile-separator) + n + (upcase appwiz-erlang-modulename) "_HEADER_FILES = " + appwiz-erlang-modulename "_sup.hrl" n + n + (upcase appwiz-erlang-modulename) "_SOURCE_FILES = \\" n + " " appwiz-erlang-modulename ".erl" " " + appwiz-erlang-modulename "_sup.erl \\" n + " " appwiz-erlang-modulename "_app.erl" " " + appwiz-erlang-modulename appwiz-erlang-ext ".erl" n + n + (upcase appwiz-erlang-modulename) "_OBJECT_FILES = $(" + (upcase appwiz-erlang-modulename) "_SOURCE_FILES:.erl=.jam)" n + n + n + (erlang-skel-makefile-separator) + "#" n + "# Transformations " n + "#" n + n + ".erl.jam:" n + " $(ERL) $<" n + n + (erlang-skel-makefile-separator) n + n + n + "def : " + appwiz-erlang-modulename n + n + appwiz-erlang-modulename ": $(" + (upcase appwiz-erlang-modulename) "_OBJECT_FILES)" n + " cp $(" (upcase appwiz-erlang-modulename) "_OBJECT_FILES) " + "$(EBIN)" n + n + "clean :" n + " /bin/rm -f $(" (upcase appwiz-erlang-modulename) + "_OBJECT_FILES)" n + n + "$(" (upcase appwiz-erlang-modulename) "_OBJECT_FILES): $(" + (upcase appwiz-erlang-modulename) "_HEADER_FILES)" n + n + ".SUFFIXES : .erl .jam" n + n + )) + +(defvar erlang-skel-makefile-middle + '((erlang-skel-include erlang-skel-nomodule-header) + "MAKE = make" n + n + (erlang-skel-makefile-separator) + n + "def:" n + " (cd src ; $(MAKE))" n + n + "clean:" n + " (cd src ; $(MAKE) clean)" n + n + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun erlang-skel-makefile-separator () + "Return a comment separator." + (concat (make-string 70 ?\#) "\n")) diff --git a/lib/tools/emacs/internal_doc/emacs.sgml b/lib/tools/emacs/internal_doc/emacs.sgml new file mode 100644 index 0000000000..5b28928605 --- /dev/null +++ b/lib/tools/emacs/internal_doc/emacs.sgml @@ -0,0 +1,3258 @@ + + +
+ The Erlang editing mode for Emacs + +Anders Lindgren + + + + + 1998-04-20 + C + emacs-user.sgml
+ +
+ Introduction + + +

+If you want to get started immediately, the chapters +"An Example for UNIX" +and +"An Example for Windows" +gives you examples of the configurations you need to make to use the +Erlang Editing mode for Emacs. +

+ + +

+Emacs has been the text editor of choice for programmers in the UNIX +community for many years. Thanks to a continuing development process, +Emacs is the most powerful editor available. Today, Emacs runs under +most operating systems including MS-Windows, OS/2, Macintosh, and +several dialects of UNIX. +

+ +

+Emacs has editing support for all major programming languages and +quite a lot of minor and unknown languages are supported as well. +

+ +

+Emacs is designed to be extendible. In the unlikely event that you +would miss a feature in Emacs you can add it yourself, or you might +find it in the large number of add-on packages that people all over +the world have written. +

+ +

+This book is the documentation to the Emacs package erlang.el. +It provides support for the programming language Erlang. The package +provides an editing mode with lots of bells and whistles, compilation +support, and it makes it possible for the user to start Erlang shells +that run inside Emacs. +

+ +

+Emacs is written by the Free Software Foundation and is part of the +GNU project. Emacs, including the source code and documentation, is +released under the GNU General Public License. +

+ +
+ +Overview of this Book + + +

This book can be divided into the following sections: + + + Introduction. This part introduces Emacs, the Erlang +editing mode, and this book. In fact, this is the section you +currently are reading. + + The editing mode. Here the editing mode is described. +The editing mode contains a whole series of features including +indentation, syntax highlighting, electric commands, module name +verification, comment support including paragraph filling, skeletons, +tags support, and much more. + + Erlang shells. How to start and use an Erlang shell +that runs inside Emacs is described in this section. + + Compilation support. This package is capable of +starting compilations of Erlang module. Should compilation errors +occur Emacs is capable of placing the cursor on the erroneous lines. + + Customization. The Erlang editing mode, like most +Emacs packages, supports extensive customization. In this chapter we +demonstrate how you can bind your favorite functions to the hotkeys +on the keyboard. It also introduces the concept of "hooks", a general +method for the user to add code that will be executed when a specific +situation occur, for example when an Erlang file is loaded into Emacs. + + + +

+The terminology used in this book is the terminology used in the +documentation to Emacs. The chapter "Notation" contains a list of commonly +used words and their meaning in the Emacs world. +

+ +

+The intended readers of this book are Emacs users. The book contains +some examples on how to customize this package using the Emacs +extension language Emacs Lisp. You can safely skip those sections. +

+ +
+
+ +
+Emacs + +

+The first component needed to get this package up and running is, of +course, an Emacs editor. You can use either the standard Emacs +distribution from FSF or XEmacs, an alternative distribution. Both +brands have their advantages and disadvantages. +

+ +

+Regardless of the brand, it is recommended to use a modern version. +If an old version is used it is possible that some of the features +provided by the editing mode cannot be used. +

+ +

+The chapter "Emacs +Distributions" below contains a short summary on the +differences between the Emacs brands, as well as instructions where to +get the distributions and how to install them. +

+ +
+ +
+Installing the Erlang Support Packages + +

+Once Emacs has been installed, it must be informed about the presence +of the Erlang support packages. +

+ +

+If you do not know if the packages have been installed open, an Erlang +source file. The mode line should contain the word "Erlang". You can +check the version of the installed package by selecting the "version" +entry in the Erlang menu in Emacs. Should no Erlang menu be present, +or if the menu does not contain a "Version" item, you are using an old +version. +

+ +

+The packages can either be installed for all users by the system +administrator, or each individual user can install it in their own +Emacs setup. The chapter "Installation of the Erlang Editing Mode" + contains a description +on how to install the packages. +

+ +
+ + +
+ The Editing Mode + +

+The Erlang editing for Emacs provides a number of features described +in this and the following chapters. The editing mode can work with +either Erlang source mode or Mnesia database rules. The Erlang +editing mode for Emacs is in Emacs terminology a Major mode . +

+ +

+When Erlang mode is correctly installed, it is automatically activated +when a file ending in .erl or .hrl is opened in Emacs. +It is possible to activate Erlang mode for other buffers as well. +

+ +

+The editing mode provides a menu containing a selection of commands +structured into logical subgroups. The menu is designed to help new +users get an overview of the features provided by the Erlang packages +while still giving full power to more advanced users. +

+ +

+Erlang mode has got a local key map that contains keyboard bindings +for a number of commands. In the chapter +"Custom Key Bindings" below, +we will demonstrate how the users can bind their favorite commands to +the local Erlang key map. +

+ +

+It is possible for the users to perform advanced customizations by +adding their own functions to the "hook" variables provided by this +package. This will be described in the "Customization" chapter below. +

+ + +
+The Mode + + +M-x erlang-mode RET
+ +

+This command activates the Erlang major mode for the current buffer. +When this mode is active the mode line contain the word "Erlang". +

+ + +
+ +
+The Version + + +M-x erlang-version RET
+ +

+This command displays the version number of the Erlang editing mode. +Remember to always supply the version number when asking questions +about Erlang mode. +

+ +

+Should this command not be present in your setup (after Erlang mode +has been activated) you probably have a very old version of the Erlang +editing mode. +

+ + +
+ +
+Module Name Check + +

+When a file is saved the name in the -module(). line is checked +against the file name. Should they mismatch Emacs can change the +module specifier so that it matches the file name. By default, the user +is asked before the change is performed. +

+ + + + Variable: erlang-check-module-name (default ask)
+ +

+This variable controls the behavior of the module name check system. +When it is t Emacs changes the module specifier without asking +the user, when it is bound to the atom ask the user is asked. +Should it be nil the module name check mechanism is +deactivated. +

+ + +
+ +
+Variables + +

+There are several variables that control the behavior of the +Erlang Editing mode. +

+ + + Variable: erlang-mode-hook
+ +

+Functions to run when the Erlang mode is activated. See chapter +"Customization" below for +examples. +

+ + + Variable: erlang-new-file-hook
+ +

+Functions to run when a new file is created. See chapter "Customization" below for examples. +

+ + + Variable: erlang-mode-load-hook
+ +

+Functions to run when the erlang package is loaded into Emacs. +See chapter "Customization" +below for examples. +

+ + + +
+
+ + + +
+Indentation + +

+The "Oxford Advanced Learners Dictionary of Current English" says the +following about the word "indent": +

+ + +

+ "start (a line of print or writing) farther from + the margin than the others". +

+ + +

+Possibly the most important feature of an editor designed for +programmers is the ability to indent a line of code in accordance +with the structure of the programming language. +

+ +

+The Erlang mode does, of course, provide this feature. The layout +used is based on the common use of the language. +

+ +

+It is strongly recommend to use this feature and avoid to indent lines +in a nonstandard way. Some motivations are: +

+ + + + Code using the same layout is easy to read and maintain. + + The indentation features can be used to reindent large sections of a +file. If some lines use nonstandard indentation they will be +reindented. + + Since several features of Erlang mode is based on the +standard layout they might not work correctly if a nonstandard layout +is used. For example, the movement commands (described in chapter +"Function and clause commands" +below) will not work unless the function headers start in the first +column. + + + +
+The Layout + +

+The basic layout is that the clause headers start in the first column, +and the bodies of clauses and complex expressions (e.g. "case" and +"if") are indented more that the surrounding code. For example: +

+ + +remove_bugs([]) -> + []; +remove_bugs([X | Xs]) + case X of + bug -> + test(Xs); + _ -> + [X | test(Xs)] + end. + + + + + + Variable: erlang-indent-level
+ +

+The depth of the indentation is controlled by the variable +"erlang-indent-level", see section "Customization" below. +

+ + + +
+ +
+Indentation of comments + +

+Lines containing comment are indented differently depending on the +number of %-characters used: +

+ + + Lines with one %-character is indented to the right of the +code. The column is specified by the variable comment-column, +by default column 48 is used. + + Lines with two %-characters will be indented to the same depth +as code would have been in the same situation. + + Lines with three of more %-characters are indented to the left +margin. + + + +

+ Example: +

+ + +%%% +%%% Function: remove_bugs +%%% + +remove_bugs([]) -> + []; +remove_bugs([X | Xs]) + case X of + bug -> % Oh no, a bug! + % Remove it. + test(Xs); + %% This element is not a bug, let's keep it. + _ -> + [X | test(Xs)] + end. + +
+ +
+ +Indentation commands + +

The following command are directly available for indentation.

+ + +TAB (erlang-indent-command)
+ +

Indent the current line of code.

+ + +M-C-\ (indent-region)
+ +

Indent all lines in the region.

+ + +M-l (indent-for-comment)
+ +

+Insert a comment character to the right of the code on the line (if +any). The comment character is placed in the column specified by the +variable "comment-column", by default column 48 is used. +

+ + +C-c C-q (erlang-indent-function)
+ +

+Indent the current Erlang function. +

+ + + M-x erlang-indent-clause RET
+ +

+Indent the current Erlang clause.

+ + +M-x erlang-indent-current-buffer RET
+ +

+Indent the entire buffer. +

+ + + +
+
+ +Customization + +

+The most common customization of the indentation system is to bind the +return key to newline-and-indent. Please see the chapter +"Custom Key Bindings" +below for an example. +

+ +

+There are several Emacs variables that control the indentation system. +

+ + + + Variable: erlang-indent-level (default 4)
+ +

+The amount of indentation for normal Erlang functions and complex +expressions. Should, for example, the value of this variable be 2 the +example above would be indented like: +

+ + +remove_bugs([]) -> + []; +remove_bugs([X | Xs]) + case X of + bug -> + test(Xs); + _ -> + [X | test(Xs)] + end. + + + + Variable: erlang-indent-guard (default 2)
+ +

The amount of indentation for Erlang guards.

+ + + Variable: erlang-argument-indent (default 2)
+ +

The amount of indentation for function calls that span several lines.

+ +

+ Example: +

+ + +foo() -> + a_very_long_function_name( + AVeryLongVariableName), + + + + Variable: erlang-tab-always-indent +(default t)
+ +

+When non-nil the TAB command always indents the line +(this is the default). When nil, the line will be indented +only when the point is in the beginning of any text on the line, +otherwise it will insert a tab character into the buffer. +

+ + + +
+
+ + + + +
+ + General Commands + +

+This chapter contains a group of commands that are not found in any +other category. Unlike most other books we do not have a chapter named +"Miscellaneous xxx" found at the end of most books. This chapter is +placed near the beginning to reflect the importance and usefulness of +the commands. +

+ +
+ +Filling comments + +

+How many times have you edited a section of text in a comment only to +wind up with a unevenly formatted paragraph? Or even worse, have you +ever decided not to edit a comment just because the formatting would +look bad? +

+ +

+When editing normal text in text mode you can let Emacs reformat the +text by the fill-paragraph command. This command will not work +for comments since it will treat the comment characters as words. +

+ +

+The Erlang editing mode provides a command that known about the Erlang +comment structure and can be used to fill text paragraphs in comments. +

+ + + +M-q (erlang-fill-paragraph)
+ +Fill the text in an Erlang comment. This command known about the +Erlang comment characters. The column to perform the word wrap is +defined by the variable fill-column. + + + +

+ Example: +

+ +

+For the sake of this example, let's assume that fill-column is set +to column 30. Assume that we have an Erlang comment paragraph on the +following form: +

+ + +%% This is just a test to show +%% how the Erlang fill +%% paragraph command works. + + +

+Assume that you would add the words "very simple" before the word +"test": +

+ + +%% This is just a very simple test to show +%% how the Erlang fill +%% paragraph command works. + + +

+Clearly, the text is badly formatted. Instead of formatting this +paragraph line by line, let's try erlang-fill-paragraph by +pressing M-q. The result is: +

+ + +%% This is just a very simple +%% test to show how the Erlang +%% fill paragraph command +%% works. + + +

+As you can see the paragraph is now evenly formatted. +

+ +
+ +
+ Creating Comments + +

+In Erlang it is possible to write comments to the right of the code. +The indentation system described in the chapter "Indentation" above is +able to indent lines containing only comments, and gives support for +end-of-the-line comments. +

+ + + +M-; (indent-for-comment)
+ +This command will create, or reindent, a comment to the right of the +code. The variable comment-column controls the placement of the +comment character. + + +
+ +
+ + Comment Region + +

+The standard command comment-region can be used to comment out +all lines in a region. To uncomment the lines in a region precede +this command with C-u. +

+ +
+
+ + + +
+Syntax Highlighting + +

+It is possible for Emacs to use colors when displaying a buffer. By +"syntax highlighting", we mean that syntactic components, for example +keywords and function names, will be colored. +

+ +

+The basic idea of syntax highlighting is to make the structure of a +program clearer. For example, the highlighting will make it easier to +spot simple bugs. Have not you ever written a variable in lower-case +only? With syntax highlighting a variable will colored while atoms +will be shown with the normal text color. +

+ +

+The syntax highlighting can be activated from the Erlang menu. There +are four different alternatives: +

+ + + + Off: Normal black and white display. + + Level 1: Function headers, reserved words, comments, strings, quoted +atoms, and character constants will be colored. + + Level 2: The above, attributes, Erlang bif:s, guards, and words +in comments enclosed in single quotes will be colored. + + Level 3: The above, variables, records, and macros will be colored. +(This level is also known as the Christmas tree level.) + + + + +

+The syntax highlighting is based on the standard Emacs package +"font-lock". It is possible to use the font-lock commands and +variables to enable syntax highlighting. The commands in question +are: +

+ + +M-x font-lock-mode RET
+ +

+This command activates syntax highlighting for the current buffer. +

+ + +M-x global-font-lock-mode RET
+ +

+Activate syntax highlighting for all buffers. +

+ + + +

+The variable font-lock-maximum-decoration is used to specify +the level of highlighting. If the variable is bound to an integer, +that level is used; if it is bound to t the highest possible +level is used. (It is possible to set different levels for different +editing modes; please see the font-lock documentation for more +information.) +

+ +

+It is possible to change the color used. It is even possible to use +bold, underlined, and italic fonts in combination with colors. +However, the method to do this differs between Emacs and XEmacs; and +between different versions of Emacs. For Emacs 19.34, the variable +font-lock-face-attributes controls the colors. For version 20 of +Emacs and XEmacs, the faces can be defined in the interactive custom +system. +

+ +
+ +Customization + +

+Font-lock mode is activated in different ways in different versions of +Emacs. For modern versions of GNU Emacs place the following lines in +your ~/.emacs file: +

+ + +(setq font-lock-maximum-decoration t) +(global-font-lock-mode 1) + + + +

+For modern versions of XEmacs the following code can be used: +

+ + +(setq auto-font-lock-mode 1) + + +

+For older versions of Emacs and XEmacs, font-lock mode must be +activated individually for each buffer. The following will add a +function to the Erlang mode hook that activates font-lock mode for all +Erlang buffers. +

+ + +(defun my-erlang-font-lock-hook () + (font-lock-mode 1)) + +(add-hook 'erlang-mode-hook 'my-erlang-font-lock-hook) + + +
+ +
+Known Problems + +

+Emacs has one problem with the syntactic structure of Erlang, namely +the $ character. The normal Erlang use of the $ character is +to denote the ASCII value of a character, for example: +

+ + +ascii_value_of_a() -> $a. + + +

+In order to get the font-lock mechanism to work for the next example, +the $ character must be marked as an "escape" character that changes +the ordinary Emacs interpretation of the following double-quote +character. +

+ + +ascii_value_of_quote() -> $". + + + +

+The problem is that Emacs will also treat the $ character as an +"escape" character at the end of strings and quoted atoms. +Practically, this means that Emacs will not detect the end of the +following string: +

+ + +the_id() -> "$id: $". + + +

+Fortunately, there are ways around this. From Erlang's point of view +the following two strings are equal: "test$" and +"test\$". The \-character is also marked as an Emacs "escape" +character, hence it will change the Emacs interpretation of the +$-character. +

+ +

+This work-around cannot always be used. For example, when the string is +used by an external version control program. In this situation we can +try to avoid placing the $-character at the end of the string, for +example: +

+ + +-vsn(" $Revision: 1.1 $ "). + + +

+Should this not be possible we can try to create an artificial end of +the string by placing an extra quote sign in the file. We do this as a +comment: +

+ + +-vsn("$Revision: 1.1 $"). % " + + + +

+The comment will be ignored by Erlang since it is a comment. From +Emacs point of view the comment character is part of the string. +

+ +

+This problem is a generic problem for languages with similar syntax. +For example, the major mode for Perl suffers from the same problem. +

+ +
+
+ + + +
+Electric Commands + +

+An "electric" command is a character that in addition to just +inserting the character performs some type of action. For example the +";" character is typed in a situation where is ends a function clause +a new function header is generated. +

+ +

+Since some people find electric commands annoying they can be +deactivated, see section "Unplugging +the Electric Commands" below. +

+ +
+ +The Commands + + + ; (erlang-electric-semicolon)
+ +

+Insert a semicolon. When ending a function or the body of a +case clause, and the next few lines are empty, the special action will +be performed. For functions, a new function header will be generated +and the point will be placed between the parentheses. (See the +command erlang-clone-arguments.) For other clauses the string +" ->" will be inserted and the point will be placed in from of +the arrow. +

+ + , (erlang-electric-comma)
+ +

+Insert a comma. If the point is at the end of the line +and the next few lines are empty, a new indented line is created. +

+ + > (erlang-electric-arrow)
+ +

+Insert a > character. If it is inserted at the end of a line +after a - character so that an arrow "->" is being +formed, a new indented line is created. This requires that the next +few lines are empty. + + RET (erlang-electric-newline)
+ +

+The special action of this command is normally off by default. When +bound to the return key the following line will be indented. Should +the current line contain a comment the initial comment characters will +be copied to the new line. For example, assume that the point is at +the end of a line (denoted by "<point>" below). +

+ + + %% A comment + + +

+When pressing return (and erlang-electric-newline is active) +the result will be: +

+ + + %% A comment + %% + + +

+This command has a second feature. When issued directly after another +electric command that created a new line this command does nothing. +The motivation is that it is in the fingers of many programmers to hit +the return key just when they have, for example, finished a function +clause with the ; character. Without this feature both the +electric semicolon and this command would insert one line each which +is probably not what the user wants. +

+ + + +
+ +
+ Undo + +

+All electric command will set an undo marker after the initial +character has been inserted but before the special action has been +performed. By executing the undo command (C-x u) the effect of +the special action will be undone while leaving the character. +Execute undo a second time to remove the character itself. +

+ +
+ +
+ Variables + +

+The electric commands are controlled by a number of variables. +

+ + + erlang-electric-commands
+ +

+This variable controls if an electric command is active or not. This +variable should contain a list of electric commands to be active. To +activate all electric commands bind this variable to the atom +t. +

+ + + erlang-electric-newline-inhibit
+ +

+When non-nil when erlang-electric-newline should do +nothing when preceded by a electric command that is member of the +list erlang-electric-newline-inhibit-list. +

+ + + erlang-electric-newline-inhibit-list
+ +

+A list of electric commands. The command +erlang-electric-newline will do nothing when preceded by a +command in this list, and the variable +erlang-electric-newline-inhibit is non-nil. +

+ + erlang-electric-X-criteria
+ +

+There is one variable of this form for each electric command. The +variable is used to decide if the special action of an electric +command should be used. The variable contains a list of criteria +functions that are called in the order they appear in the list. +

+

+If a criteria function returns the atom stop the special +action is not performed. + +If it returns a non-nil value the action is taken. + +If it returns nil the next function in the list is called. + +Should no function in the list return +a non-nil value the special action will not be executed. + +Should the list contain the atom t the special action is performed +(unless a previous function returned the atom stop). +

+ + + erlang-next-lines-empty-threshold (default 2)
+ +

+Should the function erlang-next-lines-empty-p be part of a +criteria list of an electric command (currently semicolon, comma, and +arrow), this variable controls the number of blank lines required. +

+ + + +
+ +
+ + Unplugging the Electric Commands + +

+To disable all electric commands set the variable +erlang-electric-commands to the empty list. In short, place the +following line in your ~/.emacs file: +

+ + +(setq erlang-electric-commands '()) + + +
+ +
+ + Customizing the Electric Commands + +

+To activate all electric commands, including +erlang-electric-newline, add the following line to your +~/.emacs file: +

+ + +(setq erlang-electric-commands t) + + +
+
+ + + + +
+ + Function and Clause Commands + +

+The Erlang editing mode has a set of commands that are aware of the +Erlang functions and function clauses. The commands can be used to +move the point (cursor) to the end of, or to the beginning of Erlang +functions, or to jump between functions. The region can be placed +around a function. Function headers can be cloned (copied). +

+ + +
+ Movement Commands + +

+There is a set of commands that can be used to move the point to +the beginning or the end of an Erlang clause or function. The +commands are also designed for movement between Erlang functions and +clauses. +

+ + + + C-a M-a (erlang-beginning-of-function)
+ +

+Move the point to the beginning of the current or preceding Erlang +function. With an argument skip backwards over this many Erlang +functions. Should the argument be negative the point is moved to the +beginning of a function below the current function. +

+ +

+This function returns t if a function was found, nil +otherwise. +

+ + + M-C-a (erlang-beginning-of-clause)
+ +

+As above but move point to the beginning of the current or preceding +Erlang clause. +

+ +

+This function returns t if a clause was found, nil otherwise. +

+ + C-a M-e (erlang-end-of-function)
+ +

+Move to the end of the current or following Erlang function. With an +argument to it that many times. Should the argument be negative move +to the end of a function above the current functions. +

+ + + M-C-e (erlang-end-of-clause)
+ +

+As above but move point to the end of the current or following Erlang +clause. +

+ + + +

+When one of the movement commands is executed and the point is already +placed at the beginning or end of a function or clause, the point is +moved to the previous/following function or clause. +

+ +

+When the point is above the first or below the last function in the +buffer, and an erlang-beginning-of-, or erlang-end-of- +command is issued, the point is moved to the beginning or to the end +of the buffer, respectively. +

+ + +

+ Development Tips + +

+The functions described above can be used both as user commands and +called as functions in programs written in Emacs Lisp. +

+ +

+ Example: +

+ +

+The sequence below will move the point to the beginning of the current +function even if the point should already be positioned at the +beginning of the function: +

+ + + (end-of-line) + (erlang-beginning-of-function) + + + +

+ Example: +

+ +

+To repeat over all the function in a buffer the following code can be +used. It will first move the point to the beginning of the buffer, +then it will locate the first Erlang function. Should the buffer +contain no functions at all the call to +erlang-beginning-of-function will return nil and hence +the loop will never be entered. +

+ + + (goto-char (point-min)) + (erlang-end-of-function 1) + (let ((found-func (erlang-beginning-of-function 1))) + (while found-func + ;; Do something with this function. + ;; Go to the beginning of the next function. + (setq found-func (erlang-beginning-of-function -1)))) + + +
+
+ +
+ +Region Commands + + + + C-c M-h (erlang-mark-function)
+ +

+Put the region around the current Erlang function. The point is +placed in the beginning and the mark at the end of the function. +

+ + M-C-h (erlang-mark-clause)
+ +

+Put the region around the current Erlang clause. The point is +placed in the beginning and the mark at the end of the function. +

+ + +
+ +
+ +Function Header Commands + + + C-c C-j (erlang-generate-new-clause)
+ +

+Create a new clause in the current Erlang function. The point is +placed between the parentheses of the argument list. +

+ + C-c C-y (erlang-clone-arguments)
+ +

+Copy the function arguments of the preceding Erlang clause. This +command is useful when defining a new clause with almost the same +argument as the preceding. +

+ + + +
+ +
+Limitations + +

+Several clauses are considered to be part of the same Erlang function +if they have the same name. It is possible that in the future the +arity of the function also will be checked. + +To avoid to perform a full parse of the entire buffer the functions +described in the chapter only look at lines where the function starts +in the first column. This means that the commands does not work +properly if the source code contain non-standardized indentation. + +

+
+ + + +
+ +Skeletons + +

+A skeleton is a piece of pre-written code that can be inserted into +the buffer. Erlang mode comes with a set of predefined skeletons +ranging from simple if expressions to stand-alone applications. +

+ +

+The skeletons can be accessed either from the Erlang menu of from +commands named tempo-template-erlang-X. +

+ +

+The skeletons is defined using the standard Emacs package "tempo". It +is possible to define new skeletons for your favorite erlang +constructions. +

+ +
+ +Commands + + + + C-c M-f (tempo-forward-mark) + C-c M-b (tempo-backward-mark) + +

+In a skeleton certain positions are marked. These two commands +move the point between such positions. +

+ + +
+ +
+ +Predefined Skeletons + + + + Simple skeletons: If, Case, Receive, Receive After, Receive Loop. + + Header elements: Module, Author. + +

+These commands inserts lines on the form -module(xxx). and +-author('my@home').. They can be used directly, but are also used +as part of the full headers described below: +

+ + + Full Headers: Small, Medium, and Large Headers + +

+These commands generate three variants of file headers. +

+ + + +

+The following skeletons will complete almost ready-to-run modules. + + + + Small Server + + application + + Supervisor + + Supervisor Bridge + + gen_server + + gen_event + + gen_fsm + + +

+ +
+Defining New Skeletons + +

+It is possible to define new Erlang skeletons. The skeletons are +defined using the standard package "tempo". The skeleton is described +using the following variables: +

+ + + + erlang-skel-X (Where X is the name of this skeleton.)
+ +

+Each skeleton is described by a variable. It contains a list of Tempo +rules. See below for two examples of skeleton definitions. See the +Tempo Reference Manual for a complete description of tempo rules. +

+ + erlang-skel
+ +

+This variable describes all Erlang skeletons. It is used to define +the skeletons and to add them to the Erlang menu. The variable is a +list where is each entry is either the empty list, representing a +vertical bar in the menu, or a list on the form: +

+ + + (Menu-name tempo-name erlang-skel-X) + + +

+The Menu-name is name to use in the menu. A named function is created +for each skeleton, it is tempo-template-erlang-tempo-name. +Finally, erlang-skel-X is the name of the variable describing the +skeleton. +

+ +

+The best time to change this variable is right after the Erlang mode +has been loaded but before it has been activated. See the "Example" +section below. +

+ + + +
+ +Examples + +

+Below is two example on skeletons and one example on how to add an +entry to the erlang-skel variable. Please see the Tempo +reference manual for details about the format. +

+ + +

+ Example 1: +

+ +

+The "If" skeleton is defined by the following variable +(slightly rearranged for pedagogical reasons): +

+ + +(defvar erlang-skel-if + '((erlang-skel-skip-blank) ;; 1 + o ;; 2 + > ;; 3 + "if" ;; 4 + n> ;; 5 + p ;; 6 + " ->" ;; 7 + n> ;; 8 + p ;; 9 + "ok" ;; 10 + n> ;; 11 + "end" ;; 12 + p)) ;; 13 + + +

+Each line describes an action to perform: +

+ + + + 1: This is a normal function call. Here we skip over any space +characters after the point. (If we do not they will end up after the +skeleton.) + + 2: This means "Open Line", i.e. split the current line at the +point, but leave the point on the end of the first line. + + 3: Indent Line. This indents the current line. + + 4: Here we insert the string if into the buffer + + 5, 8, 11: Newline and indent. + + 6, 9, 13: Mark these positions as special. The point will be +placed at the position of the first p. The point can later be +moved to the other by the tempo-forward-mark and +tempo-backward-mark described above. + + 7, 10, 12: These insert the strings " ->", +"ok", and "end", respectively. + + + +

+ Example 2: +

+ +

+This example contains very few entries. Basically, what it does is to +include other skeletons in the correct place. +

+ + +(defvar erlang-skel-small-header + '(o ;; 1 + (erlang-skel-include erlang-skel-module ;; 2 + erlang-skel-author) + n ;; 3 + (erlang-skel-include erlang-skel-compile ;; 4 + erlang-skel-export ;; 5 + erlang-skel-vc))) ;; 6 + + +

+The lines performs the following actions: +

+ + + 1: "Open Line" (see example 1 above). + + 2: Insert the skeletons erlang-skel-module and +erlang-skel-compile into the buffer. + + 3: Insert one empty line. + + 4: Insert three more skeletons. + + + +

+ Example 3: +

+ +

+Here we assume that we have defined a new skeleton named +erlang-skel-example. The best time to add this skeleton to the +variable erlang-skel is when Erlang mode has been loaded but +before it has been activated. We define a function that adds two +entries to erlang-skel, the first is () that represent a +divisor in the menu, the second is the entry for the Example +skeleton. We then add the function to the erlang-load-hook, a +hook that is called when Erlang mode is loaded into Emacs. + + +(defun my-erlang-skel-hook () + (setq erlang-skel + (append erlang-skel + '(() + ("Example" "example" erlang-skel-example))))) + +(add-hook 'erlang-load-hook 'my-erlang-skel-hook) + + +

+
+
+ + + +
+ +Manual Pages + +

+The UNIX version of Erlang tools contain a set of manual pages that +can be accessed by the standard UNIX command "man". The Erlang mode +place a list of all available manual pages in the "Erlang" menu. +

+ +

+Unfortunately this feature is not available in the Windows version of +the Erlang editing mode since the Erlang tools are not delivered with +the manual pages. +

+ +
+ The Menu + +

+In the Erlang menu a list of all Erlang manual pages can be found. +The menu item "Man Pages". The sub-menu to this menu item contains a +list of categories, normally "Man - Commands" and "Man - Modules". +Under these is a menu containing the names of the man pages. +Should this menu be to large it is split alphabetically into a number +of sub-menus. +

+ +

+The menu item "Man - Function" is capable of finding the man page of a +named Erlang function. This commands understands the +module:function notation. This command defaults to the name under +the point. Should the name not contain a module name the list of +imported modules is searched. +

+ +
+ +
+Customization + +

+The following variables control the manual page feature. +

+ + + + erlang-man-dirs
+ +

+This variable is a list representing the sub-menu to the "Man Pages" +menu item in the Erlang menu. Each element is a list with three +elements. The first is the name of the menu, e.g. "Man - Modules" or +"Man - Local Stuff". The second is the name of a directory. The +third is a flag that control the interpretation of the directory. +When nil the directory is treated as an absolute path, when +non-nil it is taken as relative to the directory named in the +variable erlang-root-dir. +

+ + + erlang-man-max-menu-size
+ +

+The maximum number of menu items in a manual page menu. If the number +of manual pages would be more than this variable the menu will be +split alphabetically into chunks each not larger than the value of +this variable. +

+ + + +
+
+ + + +
+Tags + +

+Tags is a standard Emacs package used to record information about +source files in large development projects. In addition to listing +the files of a project, a tags file normally contains information +about all functions and variables that are defined. By far, the most +useful command of the tags system is its ability to find the +definition of functions in any file in the project. However the Tags +system is not limited to this feature, for example, it is possible to +do a text search in all files in a project, or to perform a +project-wide search and replace. +

+ +
+Creating a TAGS file + +

+In order to use the Tags system a file named TAGS must be created. +The file can be seen as a database over all functions, records, and +macros in all files in the project. The TAGS file can be created +using to different methods for Erlang. The first is the standard +Emacs utility "etags", the second is by using the Erlang module +tags. +

+ +
+ +
+The etags utility + + +

+The etags is a program that is part of the Emacs distribution. It +is normally executed from a command line, like a unix shell or a DOS +box. +

+ +

+The etags program of fairly modern versions of Emacs and XEmacs +has native support for Erlang. To check if your version does include +this support, issue the command etags --help at a the command +line prompt. At the end of the help text there is a list of supported +languages. Unless Erlang is a member of this list I suggest that you +should upgrade to a newer version of Emacs. +

+ +

+As seen in the help text -- unless you have not upgraded your Emacs yet +(well, what are you waiting around here for? Off you go and upgrade!) +-- etags associate the file extensions .erl and +.hrl with Erlang. +

+ +

+Basically, the etags utility is runed using the following form: +

+ + + etags file1.erl file2.erl + + +

+This will create a file named TAGS in the current directory. +

+ +

+The etags utility can also read a list of files from its standard +input by supplying a single dash in place of the file names. This +feature is useful when a project consists of a large number of files. +The standard UNIX command find can be used to generate the list of +files, e.g: +

+ + + file . -name "*.[he]rl" -print | etags - + + +

+The above line will create a TAGS file covering all the Erlang +source files in the current directory, and in the subdirectories +below. +

+ +

+Please see the GNU Emacs Manual and the etags man page for more info. +

+ + +

+The code implementing the Erlang support for the etags program has +been donated to the Free Software Foundation by the company Anders +Lindgren Development. +

+ +
+ +
+The tags Erlang module + + +

+One of the tools in the Erlang distribution is a module named +tags. This tool can create a TAGS file from Erlang +source files. +

+ +

+The following are examples of useful functions in this module. Please +see the reference manual on tags for details. +

+ + + + tags:file('foo.erl').
+ +

+Create a TAGS file for the file "foo.erl". +

+ + tags:subdir('src/project/', [{outfile, 'project.TAGS'}]).
+ +

+Create a tags file containing all Erlang source files in the directory +"src/project/". The option outfile specify the name of +the created TAGS file. +

+ + tags:root([{outdir, 'bar'}]).
+ +

+Create a TAGS file of all the Erlang files in the Erlang +distribution. The TAGS file will be placed in the the directory +bar. +

+ + + +
+ +
+Additional Erlang support + +

+The standard Tags system has only support for simple names. The +naming convention module:function used by Erlang is not supported. +

+ +

+The Erlang mode supplies an alternative set of Tags functions that is +aware of the format module:function. When selecting a the +default search string for the commands the name under the point is +first selected. Should the name not contain a module name the +-import list at the beginning of the buffer is scanned. +

+ +
+ +Limitations + +

+Currently, the additional Erlang module name support is not compatible +with the etags.el package that is part of XEmacs. +

+ +
+
+ +
+Useful Tags Commands + + + + M-. (erlang-find-tag)
+ +

+Find a function definition. The default value is the function name +under the point. Should the function name lack the module specifier +the -import list is searched for an appropriate candidate. +

+ + + C-u M-. (erlang-find-tag with an argument)
+ +

+The find-tag commands place the point on the first occurrence of +a function that match the tag. This command move the point to the +next match. +

+ + + C-x 4 . (erlang-find-tag-other-window)
+ +

+As above, but the new file will be shown in another window in the same +frame. +

+ + + C-x 5 . (erlang-find-tag-other-frame)
+ +

+As erlang-find-tag but the new file will be shown in a new frame. +

+ + M-TAB (erlang-complete-tag)
+ +

+This command is used to fill in the end of a partially written +function name. For example, assume that the point is at the end of +the string a_long, and the Tags file contain the function +a_long_function_name. By executing this command the string +a_long will be expanded into a_long_function_name. +

+ + + M-x tags-search RET
+ +

+This command will search through all the files in a project for a +string. (Actually, it search for a pattern described by a regular +expression.) +

+ + + M-, (tags-loop-continue)
+ +

+Move the point to the next search match. +

+ + + +
+
+ +
+IMenu + +

+IMenu is a standard package of GNU Emacs. With IMenu it is possible +to get a menu in the menu bar containing all the functions in the +buffer. Erlang mode provides support for Erlang source files. +

+ + + +
+Starting IMenu + + + + M-x imenu-add-to-menubar RET
+ +

+This command will create the IMenu menu containing all the functions +in the current buffer. The command will ask you for a suitable name +for the menu. +

+ + +
+ +
+Customization + +

+See chapter "Customization" +below for a general description on how to customize the Erlang mode. +

+ +

+To automatically create the IMenu menu for all Erlang buffers, place +the lines below into the appropriate init file (e.g. ~/.emacs). The +function my-erlang-imenu-hook will be called each time an +Erlang source file is read. It will call the +imenu-add-to-menubar function. The menu will be named +"Functions". +

+ + +(add-hook 'erlang-mode-hook 'my-erlang-imenu-hook) + +(defun my-erlang-imenu-hook () + (if (and window-system (fboundp 'imenu-add-to-menubar)) + (imenu-add-to-menubar "Functions"))) + + +
+
+ + + + + +
+Running Erlang from Emacs + +

+One of the strengths of Emacs is its ability to start slave processes. +Since Emacs is extendible it is possible let Emacs be a part of a +large application. For example, Emacs could be used as the user +interface for Erlang applications. +

+ +

+The Erlang editing mode provides two simple, yet very useful, +applications. The first is to start an Erlang shell and use an Emacs +buffer for input and output. The second is a compile commands that +makes it possible to compile Erlang modules and to locate the lines +containing the compilation errors. +

+ +

+The actual communication between Emacs and Erlang can be performed by +different low-level techniques. The Erlang editing mode provides a +technique called "inferior" processes. The add on package Erl'em +supplies a technically much more advanced communication technique +known as an Erl'em link. All the commands that are provided by the +editing mode can use either technique. However, more advanced +packages will probably need features only provided by the Erl'em +package. +

+ +
+Inferior Erlang + +

+The editing mode is capable of starting a so called "inferior" Erlang +process. This is a normal subprocess that use one Emacs buffer for +input and output. The effect is that a command line shell, or an +Erlang shell, can be displayed inside Emacs. +

+ +

+The big drawback with an inferior process is that the communication +between Emacs and the process is limited to commands issued at the +command line. Since this is the interface that is used by the user it +is difficult, to say the least, to write an Emacs application that +communicate with the inferior process. For example, the +erlang-compile command described in the section "Compilation" +below really stretch the capabilities of the inferior Erlang process. +In fact, should the user have issued a command that would take some +time to complete it is impossible for Emacs to perform the +erlang-compile command. +

+ +
+ + +
+The Erl'em Link + +

+The Erl'em package established a low-level communication channel +between Emacs and an Erlang node. This communication channel can be +used by Emacs to issue several independent Erlang commands, to start +Erlang processes and to open several Erlang IO streams. It is also +possible for Erlang to call Emacs functions. +

+ +

+In short the Erl'em package is designed to be the base of complex +application that is partially implemented in Emacs and partially in +Erlang. +

+ +

+It is the hope of the author that the Erl'em link in the future will +be used as the base for porting the user interface of the Erlang +debugger to Emacs. If this could be possible, Emacs could be used as +an Integrated Debugger Environment (IDE) for Erlang. +

+ +

+The structure of the Erl'em link and its programming interface is +described in the text "Erl'em Developers Manual". +

+ +
+
+ + + +
+Erlang Shell + +

+It is possible to start an Erlang shell inside Emacs. The shell will +use an Emacs buffer for input and output. Normal Emacs commands can +be used to edit the command line and to recall lines from the command +line history. +

+ +

+The output will never be erased from the buffer so you will never risk +letting important output fall over the top edge of the display. +

+ +

+As discussed in the previous chapter there are two low-level +methods for Emacs to communicate with Erlang. The first is by +starting an inferior process, the second is by using an Erl'em link. +When using inferior processes each new shell will start a new Erlang +node. Should the Erl'em link be used it is possible to start several +shells on the same node, a feature not normally available. +

+ +
+The shell + +

+In this section we describe how to start a shell. In the next we cover +how to use it once it has been started. +

+ + + M-x erlang-shell RET
+ +

+Start a new Erlang shell. When an inferior process is used a new +Erlang node is started for each shell. Should the Erl'em link package +be installed several shells can be started on the same Erlang node. +

+ +

+A word of warning. The Erlang function halt(). will kill the +current Erlang node, including all shells running on it. +

+ + + M-x erlang-shell-display RET
+ +

+Display one Erlang shell. If there are no Erlang shells active a new +will be started. +

+ + + +
+ +
+ +Command line history + +

+The look and feel on an Erlang shell inside Emacs should be the same +as in a normal Erlang shell. There is just one major difference, the +cursor keys will actually move the cursor around just like in any +normal Emacs buffer. The command line history can be accessed by the +following commands: +

+ + + + C-up or M-p (comint-previous-input)
+ +

+Move to the previous line in the input history. +

+ + + C-down or M-n (comint-next-input)
+ +

+Move to the next line in the input history. +

+ + + +

+If the Erlang shell buffer would be killed the command line history is +saved to a file. The command line history is automatically retrieved +when a new Erlang shell is started. +

+ +
+ +
+ +The Erlang Shell Mode + +

+The buffers that are used to run Erlang shells use the major mode +erlang-shell-mode. This major mode is based on the standard +mode comint-mode. +

+ + + erlang-shell-mode
+ +

+Enter Erlang shell mode. To operate correctly the buffer should be in +Comint mode when this command is called. +

+ + + +
+ +
+ +Variables + +

+In this section we present the variables that control the behavior of +the Erlang shell. See also the next section "Inferior Erlang +Variables". +

+ + + + Variable: erlang-shell-mode-hook +(default ())
+ +

+Function to run when this mode is activated. See chapter "Customization" below for examples. +

+ + + Variable: erlang-input-ring-file-name +(default "~/.erlang_history")
+ +

+The file name used to save the command line history. +

+ + + Variable: erlang-shell-function +(default inferior-erlang)
+ +

+This variable contain the low-level function to call to start an +Erlang shell. This variable will be changed by the Erl'em +installation. +

+ + + Variable: erlang-shell-display-function +(default inferior-erlang-run-or-select)
+ +

+This variable contain the low-level function to call when the +erlang-shell-display is issued. This variable will be changed by +the Erl'em installation. +

+ + + +
+ +
+Inferior Erlang Variables + +

+The variables described in this chapter are only used when inferior +Erlang processes are used. They do not affect the behavior of the +shell when using an Erl'em link. +

+ + + + Variable: +inferior-erlang-display-buffer-any-frame (default +nil)
+ +

+When this variable is nil the command +erlang-shell-display will display the inferior process in the +current frame. When t, it will do nothing when it already is +visible in another frame. When it is bound to the atom raise +the frame displaying the buffer will be raised. +

+ + Variable: inferior-erlang-shell-type +(default newshell)
+ +

+There are two different variants of the Erlang shell, named the old +and the new shell. The old is a simple variant that does not provide +command line editing facilities. The new, on the other hand, provide +full edition features. Apart from this major difference, they differ +on some subtle points. Since Emacs itself takes care of the command +line edition features you can switch between the two shell types if +your shell behaves strange. +

+ +

+To use the new or the old shell bind this variable to newshell or +oldshell, respectively. +

+ + Variable: inferior-erlang-machine +(default "erl")
+ +

+The command name of the Erlang runtime system. +

+ + + Variable: inferior-erlang-machine-options +(default ())
+ +

+A list of strings containing command line options that is used when +starting an inferior Erlang. +

+ + + Variable: inferior-erlang-buffer-name +(default "*erlang*")
+ +

+The base name of the Erlang shell buffer. Should several Erlang shell +buffers be used they will be named *erlang*<2>, +*erlang*<3> etc. +

+ + + +
+
+ + + +
+Compilation + +

+The classic edit-compile-bugfix cycle for Erlang is to edit the source +file in an editor, save it to a file and switch to an Erlang shell. +In the shell the compilation command is given. Should the compilation +fail you have to bring out the editor and locate the correct line. +

+ +

+With the Erlang editing mode the entire edit-compile-bugfix cycle can +be performed without leaving Emacs. Emacs can order Erlang to compile +a file and it can parse the error messages to automatically place the +point on the erroneous lines. +

+ +
+ +Commands + + + + C-c C-k (erlang-compile)
+ +

+This command compiles the file in the current buffer. +

+ +

+The action performed by this command depend on the low-level +communication method used. Should an inferior Erlang process be used +Emacs tries to issue a compile command at the Erlang shell prompt. +The compilation output will be sent to the shell buffer. +This command will fail if it is not possible to issue a command at the +Erlang shell prompt. +

+ +

+Should an Erl'em link be used the compile command sent to Erlang will +be independent of any active shell. The output will be sent to a +dedicated buffer. +

+ + + C-x ` (erlang-next-error)
+ +

+This command will place the point on the line where the first error +was found. Each successive use of this command will move the point to +the next error. The buffer displaying the compilation errors will be +updated so that the current error will be visible. +

+ +

+You can reparse the compiler output from the beginning by preceding +this command by C-u . +

+ + erlang-compile-display
+ +

+Show the output generated by the compile command. +

+ + +
+ +
+Variables + + + + Variable: erlang-compile-use-outdir +(default t)
+ +

+In some versions of Erlang the outdir options contains a bug. +Should the directory not be present in the current Erlang load path +the object file will not be loaded. +

+ +

+Should this variable be set to nil the erlang-compile +command will use a workaround by change current directory, compile the +file, and change back. +

+ + + Variable: erlang-compile-function +(default inferior-erlang-compile)
+ +

+The low-level function to use to compile an Erlang module. +

+ + + Variable: erlang-compile-display-function +(default inferior-erlang-run-or-select)
+ +

+The low-level function to call when the result of a compilation should +be shown. +

+ + + Variable: erlang-next-error-function +(default inferior-erlang-next-error)
+ +

+The low-level function to use when erlang-next-error is used. +

+ + + +
+
+ + + +
+Customization + +

+One of the strengths of Emacs is that users can fairly easy customize +the behavior of almost every detail. The Erlang editing mode is not +an exception to this rule. +

+ +

+Normally, Emacs is customized through the user and system init files, +~/.emacs and site-start.el, respectively. The content +of the files are expressions written in the Emacs extension language +Emacs Lisp. The semantics of Lisp is fairly similar Erlang's. +However, the syntax is very different. Fortunately, most +customizations require only very minor knowledge of the language. +

+ +
+ +Emacs Lisp + +

+In this section we show the basic constructions of Emacs Lisp needed to +perform customizations. +

+ +

+In addition to placing the expressions in the init file, they can be +evaluated while Emacs is started. One method is to use the M-: + (On older versions of Emacs this is bound to ESC ESC) +function that evaluates Emacs Lisp expressions in the minibuffer. +Another method is to write the expressions in the *scratch* buffer, +place the point at the end of the line and press C-j. +

+ +

+Below is a series of example that we use to demonstrate simple Emacs +Lisp constructions. +

+ + + + + Example 1:
+ +

+In this example we set the variable foo to the value 10 added +to the value of the variable a. As we can see by this example, +Emacs Lisp use prefix form for all function calls, including simple +functions like +. +

+ + +(setq foo (+ 10 a)) + + + + Example 2:
+ +

+In this example we first define a function bar that sums the value +of its four parameters. Then we evaluated an expression that first +calls bar then calls the standard Emacs function message. +

+ + +(defun bar (a b c d) + (+ a b c d)) + +(message "The sum becomes %d" (bar 1 2 3 4)) + + + + Example 3:
+ +

+Among the Emacs Lisp data types we have atoms. However, in +the following expressions we assign the variable foo the value of +the variable bar. +

+ + +(setq foo bar) + + +

+To assign the variable foo the atom bar we must quote +the atom with a '-character. Note the syntax, we should precede the +expression (in this case bar) with the quote, not surround it. +

+ + +(setq foo 'bar) + + + + +
+ + +
+Hooks + +

+A hook variable is a variable that contain a list of functions to +run. In Emacs there is a large number of hook variables, each is +runed at a special situation. By adding functions to hooks the user +make Emacs automatically perform anything (well, almost). +

+ +

+To add a function to a hook you must use the function add-hook. +To remove it use remove-hook. +

+ +

+See chapter "The Editing Mode" above for a list of hooks defined by +the Erlang editing mode. +

+ + + Example:
+ +

+In this example we add tempo-template-erlang-large-header to +the hook erlang-new-file-hook. The effect is that whenever a +new Erlang file is created a file header is immediately inserted. +

+ + + (add-hook 'erlang-new-file-hook 'tempo-template-erlang-large-header) + + + Example:
+ +

+Here we define a new function that sets a few variables when it is +called. We then add the function to the hook erlang-mode-hook that +gets called every time Erlang mode is activated. +

+ + +(defun my-erlang-mode-hook () + (setq erlang-electric-commands t)) + +(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) + + + + +
+ +
+ +Custom Key Bindings + +

+It is possible to bind keys to your favorite commands. Emacs use a +number of key-maps: the global key-map defines the default value of +keys, local maps are used by the individual major modes, minor modes +can have their own key map etc. +

+ +

+The commands global-set-key and local-set-key defines +keys in the global and in the current local key-map, respectively. +

+ +

+If we would like to redefine a key in the Erlang editing mode we can +do that by activating Erlang mode and call local-set-key. To +automate this we must define a function that calls +local-set-key. This function can then be added to the Erlang +mode hook so that the correct local key map is active when the key is +defined. +

+ +

+ Example: +

+ +

+Here we bind C-c C-c to the command erlang-compile, +the function key f1 to erlang-shell, and M-f1 +to erlang-shell-display . The calls to local-set-key +will not be performed when the init file is loaded, they will be +called first when the functions in the hook erlang-mode-hook is +called, i.e. when Erlang mode is started. +

+ + +(defun my-erlang-keymap-hook () + (local-set-key (read-kbd-macro "C-c C-c") 'erlang-compile) + (local-set-key (read-kbd-macro "") 'erlang-shell) + (local-set-key (read-kbd-macro "M-") 'erlang-shell-display)) +(add-hook 'erlang-mode-hook 'my-erlang-keymap-hook) + + +

+The function read-kbd-macro used in the above example converts +a string of readable keystrokes into Emacs internal representation. +

+ +

+ Example: +

+ +

+In Erlang mode the tags commands understand the Erlang module naming +convention. However, the normal tags commands does not. This line +will bind M-. in the global map to erlang-find-tag. +

+ + +(global-set-key (read-kbd-macro "M-." 'erlang-find-tag)) + + +
+
+ + + +
+ +Emacs Distributions + +

+Today there are two major Emacs development streams. The first is +GNU Emacs from Free Software Foundation and the second is XEmacs. +Both have advantages and disadvantages, you have to decide for +yourself which Emacs you prefer. +

+ +
+ + GNU Emacs + +

+This is the standard distribution from The Free Software Foundation, +an organization lead by the original author of Emacs, Richard +M. Stallman. +

+ +

+The source code for the latest version of Emacs can be fetched from +http://www.gnu.org. A binary distribution for Window NT and 95 +can be found at +http://www.cs.washington.edu/homes/voelker/ntemacs.html. +

+ +
+ +
+ + XEmacs + +

+This is an alternative version of Emacs. Historically XEmacs is based +on Lucid Emacs that in turn was based on an early version of Emacs 19. +The big advantage of XEmacs is that it can handle graphics much +better. One difference is a list of icons that contains a number of +commonly used commands. Another is the ability to display graphical +images in the buffer. +

+ +

+The major drawback is that when a new feature turns up in GNU Emacs, +it will often take quite a long time before it will be incorporated +into XEmacs. +

+ +

+The latest distribution can be fetched from http://www.xemacs.org. +

+ +
+ +
+ Installing Emacs + +

+The source distributions usually comes in a tared and gzipped format. +Unpack this with the following command: +

+ + + tar zxvf .tar.gz + + +

+If your tar command do not know how to handle the "z" (unpack) option +you can unpack it separately: +

+ + + gunzip .tar.gz + tar xvf .tar + + +

+The program gunzip is part of the gzip package that can +be found on the http://www.gnu.org site. +

+ +

+Next, read the file named INSTALL. The build process is +normally performed in three steps: in the first the build system +performs a number of tests on your system, the next step is to +actually build the Emacs executable, finally Emacs is installed. +

+ +
+
+ + + +
+ + Installation of the Erlang Editing Mode + +

+In the OTP installation, the Erlang editing mode is already +installed. All that is needed is that the system administrator or the +individual user configures their Emacs Init files to use it. + +

+If we assume that OTP has been installed in +OTP_ROOT, the editing mode can be found in +OTP_ROOT/misc/emacs. + +

+The erlang.el file found in the installation directory is already +compiled. If it needs to be recompiled, the following command line +should create a new erlang.elc file: + + + emacs -batch -q -no-site-file -f batch-byte-compile erlang.el + + +

+ +

+Editing the right Emacs Init file +

+System administrators edit site-start.el, individuals edit +their .emacs files. + +

+On UNIX systems, individuals should edit/create the file .emacs +in their home directories. + +

+On Windows NT/95, individuals should also edit/create their +.emacs file, but the location of the file depends on the +configuration of the system. + +

+ + +If the HOME environment variable +is set, Emacs will look for the .emacs file in the directory +indicated by the HOME variable. + + + +If HOME is not set, +Emacs will look for the .emacs file in C:\. + +

+ + +
+ Extending the load path +

+The directory with the editing mode, +OTP_ROOT/misc/emacs, must be in the load path for Emacs. + +

+Add the following line to the selected initialization file (replace + OTP_ROOT with the name of the installation +directory for OTP, keep the quote characters): +

+ + (setq load-path (cons "OTP_ROOT/misc/emacs" load-path)) + + + +

+Note: When running under Windows, use / or \\ as +separator in pathnames in the Emacs configuration files. Using a single + \ in strings does not work, as it is interpreted by Emacs as +an escape character. +

+ + +
+ +
+ Specifying the OTP installation directory + +

+Some functions in the Erlang editing mode require that the OTP +installation directory is known. The following is an example where we +assume that they are installed in the directory OTP_ROOT, +change this to reflect the location on your system. +

+ + + (setq erlang-root-dir "OTP_ROOT") + + +
+ +
+Extending the execution path + +

+To use inferior Erlang Shells, you need to do the following +configuration. If your PATH environment variable already +includes the location of the erl or erl.exe executable +this configuration is not necessary. + +

+You can either extend the PATH environment variable with the +location of the erl/erl.exe executable. Please refer to +instructions for setting environment variables on your particular +platform for details. + +

+You can also extend the execution path for Emacs as described +below. If the executable is located in OTP_ROOT/bin then you +add the following line to you Emacs Init file: + + + (setq exec-path (cons "OTP_ROOT/bin" exec-path)) + + +

+ +
+Final setup +

+Finally, add the following line to the init file: +

+ + + (require 'erlang-start) + + +

+This will inform Emacs that the Erlang editing mode is available. It +will associate the file extensions .erl and .hrl +with Erlang mode. Also it will make sure that files with the +extension .beam will be ignored when using file name +completion. +

+ +
+ +
+ + An Example for UNIX + +

+Below is a complete example of what should be added to a user's +.emacs provided that OTP is installed in the directory +/usr/local/otp: + + +(setq load-path (cons "/usr/local/otp/misc/emacs" + load-path)) +(setq erlang-root-dir "/usr/local/otp") +(setq exec-path (cons "/usr/local/otp/bin" exec-path)) +(require 'erlang-start) + + +

+Any additional user configurations can be added after this. See for +instance section "Customization" for some useful +customizations. + + +

+ +
+ + An Example for Windows + +

+Below is a complete example of what should be added to a user's +.emacs provided that OTP is installed in the directory +C:\Program Files\erl-4.7: + + +(setq load-path (cons "C:/Program Files/erl-4.7/misc/emacs" + load-path)) +(setq erlang-root-dir "C:/Program Files/erl-4.7") +(setq exec-path (cons "C:/Program Files/erl-4.7/bin" exec-path)) +(require 'erlang-start) + + +

+Any additional user configurations can be added after this. See for +instance section "Customization" for some useful +customizations. + + + +

+ + +
+ Check the Installation + +

+Restart the Emacs and load or create an Erlang file (with the .erl +extension). If the installation was performed correctly the mode line +should contain the word "Erlang". Select the "Version" menu item in +the "Erlang" menu, check that the version number matches the version in +found in the files in OTP_ROOT/misc/emacs. +

+ +
+
+ + + +
+ + Notation + +

+In this book we use the same terminology used in the Emacs +documentation. This chapter contain a short glossary of words and +their meaning in the Emacs world. +

+ + + + Buffer + +

+A buffer is used by Emacs to handle text. When editing a file the +content is loaded into a buffer. However buffers can contain other +things as well. For example, a buffer can contain a list of files in +a directory, it can contain generated help texts, or it is possible to +start processes that use a buffer in Emacs for input and output. A +buffer need not be visible, but if it is, it is shown in a window. +

+ + Emacs Lisp + +

+Emacs is written in two languages. The Emacs core is written in C. +The major part, as well as most add-on packages, are written in Emacs +Lisp. This is also the language used by the init files. +

+ + Frame + +

+This is what most other systems refer to as a window . +Emacs use frame since the word window was used for another feature +long before window systems were invented. +

+ + init file + +

+Files read by Emacs at startup. The user startup file is named +~/.emacs. The init files are used to customize Emacs, for +example to add new packages like erlang. The language used in +the startup files is Emacs Lisp. +

+ + Major mode + +

+A major mode provides support for edit text of a particular sort. For +example, the Erlang editing mode is a major mode. Each buffer have +exactly one major mode active. +

+ + Minor mode + +

+A minor mode provides some additional support. Each buffer can have +several minor modes active at the same time. One example is +font-lock-mode that activates syntax highlighting, another is +follow-mode that make two side-by-side windows act like one +tall window. +

+ + Mode line + +

+The line at the bottom of each Emacs window that contain information +about the buffer. E.g. the name of the buffer, the line number, and +the name of the the current major mode. +

+ + nil + +

+The value used in Emacs Lisp to represent false. True can be +represented by any non-nil value, but it is preferred to use +t. +

+ + Point +

+The point can be seen as the position of the cursor. More precisely, +the point is the position between two characters while the cursor is +drawn over the character following the point. +

+ + t + +

+The value t is used by flags in Emacs Lisp to represent true. +See also nil. +

+ + Window + +

+An area where text is visible in Emacs. A frame (which is a +window in non-Emacs terminology) can contain one or more windows. New +windows can be created by splitting windows either vertically or +horizontally. +

+ + +
+ + + +
+ Keys + + + + C- The control key. + + M- The meta key. Normally this is the left ALT key. +Alternatively the escape key can be used (with the difference that the +escape key should be pressed and released while the ALT key work just +like the control key.) + + M-C- Press both meta and control at the same time. (Or press the +escape key, release it, and then press the control key.) + + RET The return key. + + + +

+All commands in Emacs have names. A named command can be executed by +pressing M-x, typing the name of the command, and hitting +RET . +

+ +
+ + + +
+ Further reading + +

+In this chapter I present some references to material on Emacs. They +are divided into the two categories "Usage" and "Development". The +first is for normal Emacs users who would like to know how to get more +power out of their editor. The second is for people who would like +to develop their own applications in Emacs Lisp. +

+ +

+Personally, I would recommend the series of books from the Free +Software Foundation, they are written by the people that wrote Emacs +and they form a coherent series useful for everyone from beginners to +experienced Emacs Lisp developers. +

+ +
+ Usage + + + + + Richard M. Stallman. GNU Emacs Manual. Free Software +Foundation, 1995.
+ +

+This is the Bible on using Emacs. It is written by the principle +author of Emacs. An on-line version of this manual is part of the +standard Emacs distribution, see the "Help->Browse Manuals" menu. +

+ + + "comp.emacs", News Group on Usenet.
+ +

+General Emacs group, everything is discussed here from beginners to +complex development issues. +

+ + + "comp.emacs.xemacs", News Group on Usenet.
+ +

+This group cover XEmacs only. +

+ + + "gnu.emacs.help", News Group on Usenet.
+ +

+This group is like "comp.emacs" except that the topic only should +cover GNU Emacs, not XEmacs or any other Emacs derivate. +

+ + + "gnu.emacs.sources", News Group on Usenet.
+ +

+In this group a lot of interesting Emacs packages are posted. In fact +only source code is permitted, questions should be redirected to one of +the other Emacs groups. +

+ + + "gnu.emacs.bugs", News Group on Usenet.
+ +

+If you have found a bug in Emacs you should post it here. Do not post +bug reports on packages that are nor part of the standard Emacs +distribution, they should be sent to the maintainer of the package. +

+ + +
+ + +
+ Development + + + + Robert J. Chassell. Programming in Emacs Lisp: an Introduction. +Free Software Foundation, 1995.
+ +

+This a good introduction to Lisp in general and Emacs Lisp in +particular. Just like the other books form FSF, this book is free and +can be downloaded from http://www.gnu.org . +

+ + + Bil Lewis et.al. The GNU Emacs Lisp Reference Manual. Free Software +Foundation, 1995.
+ +

+This is the main source of information for any serious Emacs +developer. This manual covers every aspect of Emacs Lisp. This +manual, like Emacs itself, is free. The manuscript can be downloaded +from http://www.gnu.org and can either be converted into printable +form or be converted into a hypertext on-line manual. +

+ + + Bob Glickstein. Writing GNU Emacs Extensions. O'Reilly, 1997.
+ +

+This is a good tutorial on how to write Emacs packages. +

+ + + Anders Lindgren. Erl'em Developers Manual. Ericsson, 1998.
+ +

+This text covers the architecture of the Erl'em communication link and +the application programmers interface to it. +

+ + + + + +

+The tempo package is presented in this manual. The latest version can +be found at http://www.lysator.liu.se . +

+ + + +
+
+ + + + + + + +
+ + Reporting Bugs + +

+Please send bug reports to the following email address: +

+ + + support@erlang.ericsson.se + + +

+Please state as accurate as possible: +

+ + + Version number of the Erlang editing mode (see the menu), Emacs, +Erlang, and of any other relevant software. + + What the expected result was. + + What you did, preferably in a repeatable step-by-step form. + + A description of the unexpected result. + + Relevant pieces of Erlang code causing the problem. + + Personal Emacs customizations, if any. + + +

+Should the Emacs generate an error, please set the emacs variable +debug-on-error to t. Repeat the error and enclose the +debug information in your bug-report. +

+ +

+To set the variable you can use the following command: +

+ + + M-x set-variable RET debug-on-error RET t RET + + +
+ + diff --git a/lib/tools/emacs/tags.3 b/lib/tools/emacs/tags.3 new file mode 100644 index 0000000000..f98069a2f3 --- /dev/null +++ b/lib/tools/emacs/tags.3 @@ -0,0 +1,61 @@ +.TH TAGS 3 1996-05-30 "Ericsson Software Technology" "ERLANG MODULE DEFINITION" +.SH MODULE +tags \- Generate Emacs TAGS file from Erlang source files. +.SH DESCRIPTION +A TAGS file is used by Emacs to find function and variable definitions +in any source file in a big project. This module can generate a TAGS +file from Erlang source files. It recognises functions, records, and +defines. +.SH EXPORTS +.TP 8 +.B root([Options]) +Create a TAGS file covering all files in the Erlang distribution. +.TP 8 +.B file(File [, Options]) +Create a TAGS file for the file `File'. +.TP 8 +.B files(FileList [, Options]) +Create a TAGS file for the files in the list `FileList'. +.TP 8 +.B dir(Dir [, Options]) +Create a TAGS file for all files in directory `Dir'. +.TP 8 +.B dirs(DirList [, Options]) +Create a TAGS file for all files in any directory in `DirList'. +.TP 8 +.B subdir(Dir [, Options]) +Descend recursively down the directory `Dir' and create a TAGS file +based on all files found. +.TP 8 +.B subdirs(DirList [, Options]) +Descend recursively down all the directories in `DirList' and create a +TAGS file based on all files found. +.SH OPTIONS +The functions above have an optional argument, \fBOptions\fR. It is a +list which can contain the following elements: +.TP 8 +.B {outfile, NameOfTAGSFile} +Create a TAGS file named `NameOfTAGSFile'. +.TP 8 +.B {outdir, NameOfDirectory} +Create a file named TAGS in the directory `NameOfDirectory'. +.P +The default behaviour is to create a file named "TAGS" in the current +directory. +.SH SEE ALSO +GNU Emacs Manual, chapter "Editing Programs", section "Tag Tables". +.P +Erlang mode V2.0 for Emacs. +.SH AUTHOR +.nf +Anders Lindgren +.fi + +.\" Local Variables: +.\" mode: nroff +.\" eval: (auto-fill-mode 1) +.\" left-margin: 0 +.\" fill-column: 70 +.\" version-control: never +.\" indent-tabs-mode: nil +.\" End: diff --git a/lib/tools/emacs/tags.erl b/lib/tools/emacs/tags.erl new file mode 120000 index 0000000000..87be7264e9 --- /dev/null +++ b/lib/tools/emacs/tags.erl @@ -0,0 +1 @@ +../src/tags.erl \ No newline at end of file diff --git a/lib/tools/emacs/test.erl.indented b/lib/tools/emacs/test.erl.indented new file mode 100644 index 0000000000..b2cc23b92b --- /dev/null +++ b/lib/tools/emacs/test.erl.indented @@ -0,0 +1,536 @@ +%% -*- erlang -*- +%% +%% %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% + +%%%------------------------------------------------------------------- +%%% File : test.erl +%%% Author : Dan Gudmundsson +%%% Description : Test emacs mode indention and font-locking +%%% this file is intentionally not indented. +%%% Copy the file and indent it and you should end up with test.erl.indented +%%% Created : 6 Oct 2009 by Dan Gudmundsson +%%%------------------------------------------------------------------- + +%% Start off with syntax highlighting you have to verify this by looking here +%% and see that the code looks alright + +-module(test). +-compile(export_all). + +%% Module attributes should be highlighted + +-export([t/1]). +-record(record1, {a, + b, + c + }). +-record(record2, { + a, + b + }). + +-define(MACRO_1, macro). +-define(MACRO_2(_), macro). + +-spec t(integer()) -> any(). + +-type ann() :: Var :: integer(). +-type ann2() :: Var :: + 'return' | 'return_white_spaces' | 'return_comments' + | 'text' | ann(). +-type paren() :: + (ann2()). +-type t1() :: atom(). +-type t2() :: [t1()]. +-type t3(Atom) :: integer(Atom). +-type t4() :: t3(foobar). +-type t5() :: {t1(), t3(foo)}. +-type t6() :: 1 | 2 | 3 | + 'foo' | 'bar'. +-type t7() :: []. +-type t71() :: [_]. +-type t8() :: {any(),none(),pid(),port(), + reference(),float()}. +-type t9() :: [1|2|3|foo|bar] | + list(a | b | c) | t71(). +-type t10() :: {1|2|3|foo|t9()} | {}. +-type t11() :: 1..2. +-type t13() :: maybe_improper_list(integer(), t11()). +-type t14() :: [erl_scan:foo() | + %% Should be highlighted + non_neg_integer() | nonempty_list() | + nonempty_improper_list() | nonempty_maybe_improper_list() | + %% Should not be highlighted + nonempty_() | nonlist() | + erl_scan:bar(34, 92) | t13() | m:f(integer() | <<_:_*16>>)]. +-type t15() :: {binary(),<<>>,<<_:34>>,<<_:_*42>>, + <<_:3,_:_*14>>,<<>>} | [<<>>|<<_:34>>|<<_:16>>| + <<_:3,_:_*1472>>|<<_:19,_:_*14>>| <<_:34>>| + <<_:34>>|<<_:34>>|<<_:34>>]. +-type t16() :: fun(). +-type t17() :: fun((...) -> paren()). +-type t18() :: fun(() -> t17() | t16()). +-type t19() :: fun((t18()) -> t16()) | + fun((nonempty_maybe_improper_list('integer', any())| + 1|2|3|a|b|<<_:3,_:_*14>>|integer()) -> + nonempty_maybe_improper_list('integer', any())| + 1|2|3|a|b|<<_:3,_:_*14>>|integer()). +-type t20() :: [t19(), ...]. +-type t21() :: tuple(). +-type t21(A) :: A. +-type t22() :: t21(integer()). +-type t23() :: #rec1{}. +-type t24() :: #rec2{a :: t23(), b :: [atom()]}. +-type t25() :: #rec3{f123 :: [t24() | + 1|2|3|4|a|b|c|d| + nonempty_maybe_improper_list(integer, any())]}. +-type t99() :: + {t2(),t4(),t5(),t6(),t7(),t8(),t10(),t14(), + t15(),t20(),t21(), t22(),t25()}. +-spec t1(FooBar :: t99()) -> t99(); + (t2()) -> t2(); + (t4()) -> t4() when is_subtype(t4(), t24); + (t23()) -> t23() when is_subtype(t23(), atom()), + is_subtype(t23(), t14()); + (t24()) -> t24() when is_subtype(t24(), atom()), + is_subtype(t24(), t14()), + is_subtype(t24(), t4()). +-spec mod:t2() -> any(). +-opaque attributes_data() :: + [{'column', column()} | {'line', info_line()} | + {'text', string()}] | {line(),column()}. +-record(r,{ + f1 :: attributes_data(), + f222 = foo:bar(34, #rec3{}, 234234234423, + aassdsfsdfsdf, 2234242323) :: + [t24() | 1|2|3|4|a|b|c|d| + nonempty_maybe_improper_list(integer, any())], + f333 :: [t24() | 1|2|3|4|a|b|c|d| + nonempty_maybe_improper_list(integer, any())], + f3 = x:y(), + f4 = x:z() :: t99(), + f17 :: 'undefined', + f18 :: 1 | 2 | 'undefined', + f19 = 3 :: integer()|undefined, + f5 = 3 :: undefined|integer()}). + + + +highlighting(X) % Function definitions should be highlighted + when is_integer(X) -> % and so should `when' and `is_integer' be + %% Highlighting + %% Various characters (we keep an `atom' after to see that highlighting ends) + $a,atom, % Characters should be marked + "string",atom, % and strings + 'asdasd',atom, % quote should be atoms?? + 'VaV',atom, + 'aVa',atom, + '\'atom',atom, + 'atom\'',atom, + 'at\'om',atom, + '#1',atom, + + $", atom, % atom should be ok + $', atom, + + "string$", atom, "string$", atom, % currently buggy I know... + "string\$", atom, % workaround for bug above + + "char $in string", atom, + + $[, ${, $\\, atom, + ?MACRO_1, + ?MACRO_2(foo), + + %% Numerical constants + 16#DD, % AD Should not be highlighted + 32#dd, % AD Should not be highlighted + 32#ddAB, % AD Should not be highlighted + 32#101, % AD Should not be highlighted + 32#ABTR, % AD Should not be highlighted + + %% Variables + Variables = lists:foo(), + _Variables = lists:foo(), % AD + AppSpec = Xyz/2, + Module42 = Xyz(foo, bar), + Module:foo(), + _Module:foo(), % AD + FooÃ…Ã… = lists:reverse([tl,hd,tl,hd]), % AD Should highlight FooÃ…Ã… + _FooÃ…Ã… = 42, % AD Should highlight _FooÃ…Ã… + + %% Bifs + erlang:registered(), + registered(), + hd(tl(tl(hd([a,b,c])))), + erlang:anything(lists), + %% Guards + is_atom(foo), is_float(2.3), is_integer(32), is_number(4323.3), + is_function(Fun), is_pid(self()), + not_a_guard:is_list([]), + %% Other Types + + atom, % not (currently) hightlighted + 234234, + 234.43, + + [list, are, not, higlighted], + {nor, is, tuple}, + ok. + +%%% +%%% Indentation +%%% + +%%% Left + +%% Indented + + % Right + + +indent_basics(X, Y, Z) + when X > 42, + Z < 13; + Y =:= 4711 -> + %% comments + % right comments + case lists:filter(fun(_, AlongName, + B, + C) -> + true + end, + [a,v,b]) + of + [] -> + Y = 5 * 43, + ok; + [_|_] -> + Y = 5 * 43, + ok + end, + Y, + %% List, tuples and binaries + [a, + b, c + ], + [ a, + b, c + ], + + [ + a, + b + ], + {a, + b,c + }, + { a, + b,c + }, + + { + a, + b + }, + + <<1:8, + 2:8 + >>, + << + 1:8, + 2:8 + >>, + << 1:8, + 2:8 + >>, + + (a, + b, + c + ), + + ( a, + b, + c + ), + + + ( + a, + b, + c + ), + + + ok; +indent_basics(Xlongname, + #struct{a=Foo, + b=Bar}, + [X| + Y]) -> + testing_next_clause, + ok; +indent_basics( % AD added clause + X, % not sure how this should look + Y, + Z) + when + X < 42, Z > 13; + Y =:= 4711 -> + foo; +indent_basics(X, Y, Z) when % AD added clause + X < 42, Z > 13; % testing when indentation + Y =:= 4711 -> + foo; +indent_basics(X, Y, Z) % AD added clause + when % testing when indentation + X < 42, Z > 13; % unsure about this one + Y =:= 4711 -> + foo. + + +indent_icr(Z) -> % icr = if case receive + %% If + if Z >= 0 -> + X = 43 div 4, + foo(X); + Z =< 10 -> + X = 43 div 4, + foo(X); + Z == 5 orelse + Z == 7 -> + X = 43 div 4, + foo(X); + true -> + if_works + end, + %% Case + case {Z, foo, bar} of + {Z,_,_} -> + X = 43 div 4, + foo(X); + {Z,_,_} when + Z =:= 42 -> % AD line should be indented as a when + X = 43 div 4, + foo(X); + {Z,_,_} + when Z < 10 -> % AD when should be indented + X = 43 div 4, + foo(X); + {Z,_,_} + when % AD when should be indented + Z < 10 % and the guards should follow when + andalso % unsure about how though + true -> + X = 43 div 4, + foo(X) + end, + %% begin + begin + sune, + X = 74234 + foo(8456) + + 345 div 43, + ok + end, + + + %% receive + receive + {Z,_,_} -> + X = 43 div 4, + foo(X); + Z -> + X = 43 div 4, + foo(X) + end, + receive + {Z,_,_} -> + X = 43 div 4, + foo(X); + Z % AD added clause + when Z =:= 1 -> % This line should be indented by 2 + X = 43 div 4, + foo(X); + Z when % AD added clause + Z =:= 2 -> % This line should be indented by 2 + X = 43 div 4, + foo(X); + Z -> + X = 43 div 4, + foo(X) + after infinity -> + foo(X), + asd(X), + 5*43 + end, + receive + after 10 -> + foo(X), + asd(X), + 5*43 + end, + ok. + +indent_fun() -> + %% Changed fun to one indention level + Var = spawn(fun(X) + when X == 2; + X > 10 -> + hello, + case Hello() of + true when is_atom(X) -> + foo; + false -> + bar + end; + (Foo) when is_atom(Foo), + is_integer(X) -> + X = 6* 45, + Y = true andalso + kalle + end), + ok. + +indent_try_catch() -> + try + io:format(stdout, "Parsing file ~s, ", + [St0#leex.xfile]), + {ok,Line3,REAs,Actions,St3} = + parse_rules(Xfile, Line2, Macs, St2) + catch + exit:{badarg,R} -> + foo(R), + io:format(stdout, + "ERROR reason ~p~n", + R); + error:R % AD added clause + when R =:= 42 -> % when should be indented + foo(R); + error:R % AD added clause + when % when should be indented + R =:= 42 -> % but unsure about this (maybe 2 more) + foo(R); + error:R when % AD added clause + R =:= foo -> % line should be 2 indented (works) + foo(R); + error:R -> + foo(R), + io:format(stdout, + "ERROR reason ~p~n", + R) + after + foo('after'), + file:close(Xfile) + end; +indent_try_catch() -> + try foo(bar) of + X when true andalso + kalle -> + io:format(stdout, "Parsing file ~s, ", + [St0#leex.xfile]), + {ok,Line3,REAs,Actions,St3} = + parse_rules(Xfile, Line2, Macs, St2); + X % AD added clause + when false andalso % when should be 2 indented + bengt -> + gurka(); + X when % AD added clause + false andalso % line should be 2 indented + not bengt -> + gurka(); + X -> + io:format(stdout, "Parsing file ~s, ", + [St0#leex.xfile]), + {ok,Line3,REAs,Actions,St3} = + parse_rules(Xfile, Line2, Macs, St2) + catch + exit:{badarg,R} -> + foo(R), + io:format(stdout, + "ERROR reason ~p~n", + R); + error:R -> + foo(R), + io:format(stdout, + "ERROR reason ~p~n", + R) + after + foo('after'), + file:close(Xfile), + bar(with_long_arg, + with_second_arg) + end; +indent_try_catch() -> + try foo() + after + foo(), + bar(with_long_arg, + with_second_arg) + end. + +indent_catch() -> + D = B + + float(43.1), + + B = catch oskar(X), + + A = catch (baz + + bax), + catch foo(), + + C = catch B + + float(43.1), + + case catch (X) of + A -> + B + end, + try sune of + _ -> foo + catch _:_ -> baf + end. + +indent_binary() -> + X = lists:foldr(fun(M) -> + <> + end, [], A), + A = <>, + B. + + +indent_comprehensions() -> + %% I don't have a good idea how we want to handle this + %% but they are here to show how they are indented today. + Result1 = [X || + #record{a=X} <- lists:seq(1, 10), + true = (X rem 2) + ], + Result2 = [X || <> <= <<0:512>>, + true = (X rem 2) + ], + + Binary1 = << <> || + #record{a=X} <- lists:seq(1, 10), + true = (X rem 2) + >>, + + Binary2 = << <> || <> <= <<0:512>>, + true = (X rem 2) + >>, + ok. diff --git a/lib/tools/emacs/test.erl.orig b/lib/tools/emacs/test.erl.orig new file mode 100644 index 0000000000..773998a4c6 --- /dev/null +++ b/lib/tools/emacs/test.erl.orig @@ -0,0 +1,536 @@ +%% -*- erlang -*- +%% +%% %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% + +%%%------------------------------------------------------------------- +%%% File : test.erl +%%% Author : Dan Gudmundsson +%%% Description : Test emacs mode indention and font-locking +%%% this file is intentionally not indented. +%%% Copy the file and indent it and you should end up with test.erl.indented +%%% Created : 6 Oct 2009 by Dan Gudmundsson +%%%------------------------------------------------------------------- + +%% Start off with syntax highlighting you have to verify this by looking here +%% and see that the code looks alright + +-module(test). +-compile(export_all). + +%% Module attributes should be highlighted + +-export([t/1]). +-record(record1, {a, + b, + c +}). +-record(record2, { + a, + b + }). + +-define(MACRO_1, macro). +-define(MACRO_2(_), macro). + +-spec t(integer()) -> any(). + +-type ann() :: Var :: integer(). +-type ann2() :: Var :: + 'return' | 'return_white_spaces' | 'return_comments' + | 'text' | ann(). +-type paren() :: + (ann2()). +-type t1() :: atom(). +-type t2() :: [t1()]. +-type t3(Atom) :: integer(Atom). +-type t4() :: t3(foobar). +-type t5() :: {t1(), t3(foo)}. +-type t6() :: 1 | 2 | 3 | + 'foo' | 'bar'. +-type t7() :: []. +-type t71() :: [_]. +-type t8() :: {any(),none(),pid(),port(), + reference(),float()}. +-type t9() :: [1|2|3|foo|bar] | + list(a | b | c) | t71(). +-type t10() :: {1|2|3|foo|t9()} | {}. +-type t11() :: 1..2. +-type t13() :: maybe_improper_list(integer(), t11()). +-type t14() :: [erl_scan:foo() | + %% Should be highlighted + non_neg_integer() | nonempty_list() | + nonempty_improper_list() | nonempty_maybe_improper_list() | + %% Should not be highlighted + nonempty_() | nonlist() | +erl_scan:bar(34, 92) | t13() | m:f(integer() | <<_:_*16>>)]. +-type t15() :: {binary(),<<>>,<<_:34>>,<<_:_*42>>, + <<_:3,_:_*14>>,<<>>} | [<<>>|<<_:34>>|<<_:16>>| +<<_:3,_:_*1472>>|<<_:19,_:_*14>>| <<_:34>>| +<<_:34>>|<<_:34>>|<<_:34>>]. +-type t16() :: fun(). +-type t17() :: fun((...) -> paren()). +-type t18() :: fun(() -> t17() | t16()). +-type t19() :: fun((t18()) -> t16()) | + fun((nonempty_maybe_improper_list('integer', any())| + 1|2|3|a|b|<<_:3,_:_*14>>|integer()) -> +nonempty_maybe_improper_list('integer', any())| +1|2|3|a|b|<<_:3,_:_*14>>|integer()). +-type t20() :: [t19(), ...]. +-type t21() :: tuple(). +-type t21(A) :: A. +-type t22() :: t21(integer()). +-type t23() :: #rec1{}. +-type t24() :: #rec2{a :: t23(), b :: [atom()]}. +-type t25() :: #rec3{f123 :: [t24() | +1|2|3|4|a|b|c|d| +nonempty_maybe_improper_list(integer, any())]}. +-type t99() :: +{t2(),t4(),t5(),t6(),t7(),t8(),t10(),t14(), +t15(),t20(),t21(), t22(),t25()}. +-spec t1(FooBar :: t99()) -> t99(); +(t2()) -> t2(); + (t4()) -> t4() when is_subtype(t4(), t24); +(t23()) -> t23() when is_subtype(t23(), atom()), + is_subtype(t23(), t14()); +(t24()) -> t24() when is_subtype(t24(), atom()), + is_subtype(t24(), t14()), + is_subtype(t24(), t4()). +-spec mod:t2() -> any(). +-opaque attributes_data() :: +[{'column', column()} | {'line', info_line()} | + {'text', string()}] | {line(),column()}. +-record(r,{ + f1 :: attributes_data(), +f222 = foo:bar(34, #rec3{}, 234234234423, + aassdsfsdfsdf, 2234242323) :: +[t24() | 1|2|3|4|a|b|c|d| + nonempty_maybe_improper_list(integer, any())], +f333 :: [t24() | 1|2|3|4|a|b|c|d| + nonempty_maybe_improper_list(integer, any())], +f3 = x:y(), +f4 = x:z() :: t99(), +f17 :: 'undefined', +f18 :: 1 | 2 | 'undefined', +f19 = 3 :: integer()|undefined, +f5 = 3 :: undefined|integer()}). + + + +highlighting(X) % Function definitions should be highlighted + when is_integer(X) -> % and so should `when' and `is_integer' be + %% Highlighting + %% Various characters (we keep an `atom' after to see that highlighting ends) + $a,atom, % Characters should be marked + "string",atom, % and strings + 'asdasd',atom, % quote should be atoms?? + 'VaV',atom, + 'aVa',atom, + '\'atom',atom, + 'atom\'',atom, + 'at\'om',atom, + '#1',atom, + + $", atom, % atom should be ok + $', atom, + + "string$", atom, "string$", atom, % currently buggy I know... + "string\$", atom, % workaround for bug above + + "char $in string", atom, + + $[, ${, $\\, atom, + ?MACRO_1, + ?MACRO_2(foo), + + %% Numerical constants + 16#DD, % AD Should not be highlighted + 32#dd, % AD Should not be highlighted + 32#ddAB, % AD Should not be highlighted + 32#101, % AD Should not be highlighted + 32#ABTR, % AD Should not be highlighted + + %% Variables + Variables = lists:foo(), + _Variables = lists:foo(), % AD + AppSpec = Xyz/2, + Module42 = Xyz(foo, bar), + Module:foo(), + _Module:foo(), % AD + FooÃ…Ã… = lists:reverse([tl,hd,tl,hd]), % AD Should highlight FooÃ…Ã… + _FooÃ…Ã… = 42, % AD Should highlight _FooÃ…Ã… + + %% Bifs + erlang:registered(), + registered(), + hd(tl(tl(hd([a,b,c])))), + erlang:anything(lists), + %% Guards + is_atom(foo), is_float(2.3), is_integer(32), is_number(4323.3), + is_function(Fun), is_pid(self()), + not_a_guard:is_list([]), + %% Other Types + + atom, % not (currently) hightlighted + 234234, + 234.43, + + [list, are, not, higlighted], + {nor, is, tuple}, + ok. + +%%% +%%% Indentation +%%% + +%%% Left + +%% Indented + +% Right + + +indent_basics(X, Y, Z) + when X > 42, +Z < 13; +Y =:= 4711 -> + %% comments + % right comments + case lists:filter(fun(_, AlongName, + B, + C) -> + true + end, + [a,v,b]) + of + [] -> + Y = 5 * 43, + ok; + [_|_] -> + Y = 5 * 43, + ok + end, + Y, + %% List, tuples and binaries + [a, + b, c + ], + [ a, + b, c + ], + + [ + a, + b +], + {a, + b,c + }, + { a, + b,c + }, + + { + a, + b + }, + +<<1:8, + 2:8 + >>, + << + 1:8, + 2:8 + >>, + << 1:8, + 2:8 + >>, + + (a, + b, + c + ), + + ( a, + b, + c + ), + + + ( + a, + b, + c + ), + + + ok; +indent_basics(Xlongname, + #struct{a=Foo, + b=Bar}, + [X| + Y]) -> + testing_next_clause, + ok; +indent_basics( % AD added clause + X, % not sure how this should look + Y, + Z) + when + X < 42, Z > 13; + Y =:= 4711 -> + foo; +indent_basics(X, Y, Z) when % AD added clause + X < 42, Z > 13; % testing when indentation + Y =:= 4711 -> + foo; +indent_basics(X, Y, Z) % AD added clause + when % testing when indentation + X < 42, Z > 13; % unsure about this one + Y =:= 4711 -> + foo. + + +indent_icr(Z) -> % icr = if case receive + %% If + if Z >= 0 -> + X = 43 div 4, + foo(X); + Z =< 10 -> + X = 43 div 4, + foo(X); + Z == 5 orelse + Z == 7 -> + X = 43 div 4, + foo(X); + true -> + if_works + end, + %% Case + case {Z, foo, bar} of + {Z,_,_} -> + X = 43 div 4, + foo(X); + {Z,_,_} when + Z =:= 42 -> % AD line should be indented as a when + X = 43 div 4, + foo(X); + {Z,_,_} + when Z < 10 -> % AD when should be indented + X = 43 div 4, + foo(X); + {Z,_,_} + when % AD when should be indented + Z < 10 % and the guards should follow when + andalso % unsure about how though + true -> + X = 43 div 4, + foo(X) + end, + %% begin + begin + sune, + X = 74234 + foo(8456) + + 345 div 43, + ok + end, + + + %% receive + receive + {Z,_,_} -> + X = 43 div 4, + foo(X); + Z -> + X = 43 div 4, + foo(X) + end, + receive + {Z,_,_} -> + X = 43 div 4, + foo(X); + Z % AD added clause + when Z =:= 1 -> % This line should be indented by 2 + X = 43 div 4, + foo(X); + Z when % AD added clause + Z =:= 2 -> % This line should be indented by 2 + X = 43 div 4, + foo(X); + Z -> + X = 43 div 4, + foo(X) + after infinity -> + foo(X), + asd(X), + 5*43 + end, + receive + after 10 -> + foo(X), + asd(X), + 5*43 + end, + ok. + +indent_fun() -> + %% Changed fun to one indention level +Var = spawn(fun(X) + when X == 2; + X > 10 -> + hello, + case Hello() of + true when is_atom(X) -> + foo; + false -> + bar + end; + (Foo) when is_atom(Foo), + is_integer(X) -> + X = 6* 45, + Y = true andalso + kalle + end), + ok. + +indent_try_catch() -> + try + io:format(stdout, "Parsing file ~s, ", + [St0#leex.xfile]), + {ok,Line3,REAs,Actions,St3} = + parse_rules(Xfile, Line2, Macs, St2) + catch + exit:{badarg,R} -> + foo(R), + io:format(stdout, + "ERROR reason ~p~n", + R); + error:R % AD added clause + when R =:= 42 -> % when should be indented + foo(R); + error:R % AD added clause + when % when should be indented + R =:= 42 -> % but unsure about this (maybe 2 more) + foo(R); + error:R when % AD added clause + R =:= foo -> % line should be 2 indented (works) + foo(R); + error:R -> + foo(R), + io:format(stdout, + "ERROR reason ~p~n", + R) + after + foo('after'), + file:close(Xfile) + end; +indent_try_catch() -> + try foo(bar) of + X when true andalso + kalle -> + io:format(stdout, "Parsing file ~s, ", + [St0#leex.xfile]), + {ok,Line3,REAs,Actions,St3} = + parse_rules(Xfile, Line2, Macs, St2); + X % AD added clause + when false andalso % when should be 2 indented + bengt -> + gurka(); + X when % AD added clause + false andalso % line should be 2 indented + not bengt -> + gurka(); + X -> + io:format(stdout, "Parsing file ~s, ", + [St0#leex.xfile]), + {ok,Line3,REAs,Actions,St3} = + parse_rules(Xfile, Line2, Macs, St2) + catch + exit:{badarg,R} -> + foo(R), + io:format(stdout, + "ERROR reason ~p~n", + R); + error:R -> + foo(R), + io:format(stdout, + "ERROR reason ~p~n", + R) + after + foo('after'), + file:close(Xfile), + bar(with_long_arg, + with_second_arg) + end; + indent_try_catch() -> + try foo() + after + foo(), + bar(with_long_arg, + with_second_arg) + end. + +indent_catch() -> + D = B + + float(43.1), + + B = catch oskar(X), + + A = catch (baz + + bax), + catch foo(), + + C = catch B + + float(43.1), + + case catch (X) of + A -> + B + end, + try sune of + _ -> foo + catch _:_ -> baf + end. + +indent_binary() -> + X = lists:foldr(fun(M) -> + <> + end, [], A), + A = <>, + B. + + +indent_comprehensions() -> +%% I don't have a good idea how we want to handle this +%% but they are here to show how they are indented today. +Result1 = [X || + #record{a=X} <- lists:seq(1, 10), + true = (X rem 2) + ], +Result2 = [X || <> <= <<0:512>>, + true = (X rem 2) + ], + +Binary1 = << <> || + #record{a=X} <- lists:seq(1, 10), + true = (X rem 2) + >>, + +Binary2 = << <> || <> <= <<0:512>>, + true = (X rem 2) + >>, +ok. diff --git a/lib/tools/emacs/vsn.mk b/lib/tools/emacs/vsn.mk new file mode 100644 index 0000000000..f33ea8b519 --- /dev/null +++ b/lib/tools/emacs/vsn.mk @@ -0,0 +1,3 @@ + +EMACS_VSN = 2.4.13 + diff --git a/lib/tools/examples/Makefile b/lib/tools/examples/Makefile new file mode 100644 index 0000000000..9fb8434633 --- /dev/null +++ b/lib/tools/examples/Makefile @@ -0,0 +1,56 @@ +# ``The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance 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_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(TOOLS_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(VSN) + +# ---------------------------------------------------- +# Common macros +# ---------------------------------------------------- +EXAMPLE_FILES = xref_examples.erl + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: + +clean: + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/examples + $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples + +release_docs_spec: diff --git a/lib/tools/examples/xref_examples.erl b/lib/tools/examples/xref_examples.erl new file mode 100644 index 0000000000..4c082195a2 --- /dev/null +++ b/lib/tools/examples/xref_examples.erl @@ -0,0 +1,42 @@ +-module(xref_examples). + +-export([script/0]). + +%% Used at Erlang/OTP for finding undefined functions and unused local +%% functions. Output are the two files ${HOME}/undefined.txt and +%% ${HOME}/unused_locals.txt. +script() -> + Root = code:root_dir(), + Dir = os:getenv("HOME"), + Server = s, + xref:start(Server), + {ok, _Relname} = xref:add_release(Server, code:lib_dir(), {name,otp}), + %% Exclude undefined functions in some modules... + Exclude = "(CORBA|Cos|Orber|Puller|Pusher|" + "StackModule|oe_Cos|mnesia).*_impl", + UndefS = "XC || (XU - X - B)", + Q = io_lib:format("Undef = ~s," + "Excluded = ~p:_/_," + "Undef - Undef || Excluded", + [UndefS, Exclude]), + {ok, Undef} = xref:q(Server, lists:flatten(Q)), + {ok, NotCalled} = xref:analyze(Server, locals_not_used), + dump("%% " ++ Root ++ + "\n%% Undefined external functions." ++ + "\n%% The second MFA is the undefined function." ++ + "\n%% Functions in modules matching the following " + "regular expression have been skipped:" ++ + "\n%% " ++ Exclude, + filename:join(Dir, "undefined.txt"), + Undef), + dump("%% " ++ Root ++ "\n%% Unused local functions.", + filename:join(Dir, "unused_locals.txt"), + NotCalled), + catch xref:stop(Server), + halt(). + +dump(H, F, T) -> + {ok, IoDev} = file:open(F,[write]), + io:format(IoDev, "~s~n", [H]), + io:format(IoDev, "~p.~n", [T]), + file:close(IoDev). diff --git a/lib/tools/info b/lib/tools/info new file mode 100644 index 0000000000..a253c25653 --- /dev/null +++ b/lib/tools/info @@ -0,0 +1,2 @@ +group: tools Tool Applications +short: A set of programming tools including a coverage analyzer etc diff --git a/lib/tools/obj/.gitignore b/lib/tools/obj/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/tools/priv/Makefile b/lib/tools/priv/Makefile new file mode 100644 index 0000000000..6fea580c00 --- /dev/null +++ b/lib/tools/priv/Makefile @@ -0,0 +1,68 @@ +# ``The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance 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_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN = $(TOOLS_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +HTDOCS_FILES = index.html + +TOOL_FILES = cover.tool + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_COMPILE_FLAGS += + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: + +clean: + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/priv + $(INSTALL_DATA) $(HTDOCS_FILES) $(RELSYSDIR)/priv + $(INSTALL_DATA) $(TOOL_FILES) $(RELSYSDIR)/priv + +release_docs_spec: + + + diff --git a/lib/tools/priv/cover.tool b/lib/tools/priv/cover.tool new file mode 100644 index 0000000000..9e72f89ff4 --- /dev/null +++ b/lib/tools/priv/cover.tool @@ -0,0 +1,2 @@ +{version,"1.2"}. +[{config_func,{cover_web,configData,[]}}]. diff --git a/lib/tools/priv/index.html b/lib/tools/priv/index.html new file mode 100644 index 0000000000..6b60ef5d0a --- /dev/null +++ b/lib/tools/priv/index.html @@ -0,0 +1,10 @@ + + +Erlang webb tools + + + + + + + diff --git a/lib/tools/src/Makefile b/lib/tools/src/Makefile new file mode 100644 index 0000000000..81933cda14 --- /dev/null +++ b/lib/tools/src/Makefile @@ -0,0 +1,112 @@ +# +# %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 + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(TOOLS_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(VSN) + +# ---------------------------------------------------- +# Common Macros +# ---------------------------------------------------- + +MODULES= cover \ + cover_web \ + eprof \ + fprof \ + cprof \ + instrument \ + make \ + tags \ + xref \ + xref_base \ + xref_compiler \ + xref_parser \ + xref_reader \ + xref_scanner \ + xref_utils + + +HRL_FILES= \ + xref.hrl + + +ERL_FILES= $(MODULES:%=%.erl) + +TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +YRL_FILE = xref_parser.yrl + +APP_FILE = tools.app +APPUP_FILE = tools.appup + +APP_SRC = $(APP_FILE).src +APP_TARGET = $(EBIN)/$(APP_FILE) + +APPUP_SRC = $(APPUP_FILE).src +APPUP_TARGET = $(EBIN)/$(APPUP_FILE) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_COMPILE_FLAGS += + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) + +clean: + rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f errs core *~ + +docs: + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +$(APP_TARGET): $(APP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DATA) $(ERL_FILES) $(YRL_FILE) $(HRL_FILES) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) \ + $(RELSYSDIR)/ebin + +release_docs_spec: diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl new file mode 100644 index 0000000000..aff3927db3 --- /dev/null +++ b/lib/tools/src/cover.erl @@ -0,0 +1,2178 @@ +%% +%% %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(cover). + +%% +%% This module implements the Erlang coverage tool. The module named +%% cover_web implements a user interface for the coverage tool to run +%% under webtool. +%% +%% ARCHITECTURE +%% The coverage tool consists of one process on each node involved in +%% coverage analysis. The process is registered as 'cover_server' +%% (?SERVER). All cover_servers in the distributed system are linked +%% together. The cover_server on the 'main' node is in charge, and it +%% traps exits so it can detect nodedown or process crashes on the +%% remote nodes. This process is implemented by the functions +%% init_main/1 and main_process_loop/1. The cover_server on the remote +%% nodes are implemented by the functions init_remote/2 and +%% remote_process_loop/1. +%% +%% TABLES +%% Each nodes has an ets table named 'cover_internal_data_table' +%% (?COVER_TABLE). This table contains the coverage data and is +%% continously updated when cover compiled code is executed. +%% +%% The main node owns a table named +%% 'cover_collected_remote_data_table' (?COLLECTION_TABLE). This table +%% contains data which is collected from remote nodes (either when a +%% remote node is stopped with cover:stop/1 or when analysing. When +%% analysing, data is even moved from the ?COVER_TABLE on the main +%% node to the ?COLLECTION_TABLE. +%% +%% The main node also has a table named 'cover_binary_code_table' +%% (?BINARY_TABLE). This table contains the binary code for each cover +%% compiled module. This is necessary so that the code can be loaded +%% on remote nodes that are started after the compilation. +%% + + +%% External exports +-export([start/0, start/1, + compile/1, compile/2, compile_module/1, compile_module/2, + compile_directory/0, compile_directory/1, compile_directory/2, + compile_beam/1, compile_beam_directory/0, compile_beam_directory/1, + analyse/1, analyse/2, analyse/3, analyze/1, analyze/2, analyze/3, + analyse_to_file/1, analyse_to_file/2, analyse_to_file/3, + analyze_to_file/1, analyze_to_file/2, analyze_to_file/3, + export/1, export/2, import/1, + modules/0, imported/0, imported_modules/0, which_nodes/0, is_compiled/1, + reset/1, reset/0, + stop/0, stop/1]). +-export([remote_start/1]). +%-export([bump/5]). +-export([transform/4]). % for test purposes + +-record(main_state, {compiled=[], % [{Module,File}] + imported=[], % [{Module,File,ImportFile}] + stopper, % undefined | pid() + nodes=[]}). % [Node] + +-record(remote_state, {compiled=[], % [{Module,File}] + main_node}). % atom() + +-record(bump, {module = '_', % atom() + function = '_', % atom() + arity = '_', % integer() + clause = '_', % integer() + line = '_' % integer() + }). +-define(BUMP_REC_NAME,bump). + +-record(vars, {module, % atom() Module name + vsn, % atom() + + init_info=[], % [{M,F,A,C,L}] + + function, % atom() + arity, % int() + clause, % int() + lines, % [int()] + no_bump_lines, % [int()] + depth, % int() + is_guard=false % boolean + }). + +-define(COVER_TABLE, 'cover_internal_data_table'). +-define(BINARY_TABLE, 'cover_binary_code_table'). +-define(COLLECTION_TABLE, 'cover_collected_remote_data_table'). +-define(TAG, cover_compiled). +-define(SERVER, cover_server). + +%% Line doesn't matter. +-define(BLOCK(Expr), {block,0,[Expr]}). +-define(BLOCK1(Expr), + if + element(1, Expr) =:= block -> + Expr; + true -> ?BLOCK(Expr) + end). + +-include_lib("stdlib/include/ms_transform.hrl"). + +%%%---------------------------------------------------------------------- +%%% External exports +%%%---------------------------------------------------------------------- + +%% start() -> {ok,Pid} | {error,Reason} +%% Pid = pid() +%% Reason = {already_started,Pid} | term() +start() -> + case whereis(?SERVER) of + undefined -> + Starter = self(), + Pid = spawn(fun() -> init_main(Starter) end), + Ref = erlang:monitor(process,Pid), + Return = + receive + {?SERVER,started} -> + {ok,Pid}; + {'DOWN', Ref, _Type, _Object, Info} -> + {error,Info} + end, + erlang:demonitor(Ref), + Return; + Pid -> + {error,{already_started,Pid}} + end. + +%% start(Nodes) -> {ok,StartedNodes} +%% Nodes = Node | [Node,...] +%% Node = atom() +start(Node) when is_atom(Node) -> + start([Node]); +start(Nodes) -> + call({start_nodes,remove_myself(Nodes,[])}). + +%% compile(ModFile) -> +%% compile(ModFile, Options) -> +%% compile_module(ModFile) -> Result +%% compile_module(ModFile, Options) -> Result +%% ModFile = Module | File +%% Module = atom() +%% File = string() +%% Options = [Option] +%% Option = {i,Dir} | {d,Macro} | {d,Macro,Value} +%% Result = {ok,Module} | {error,File} +compile(ModFile) -> + compile_module(ModFile, []). +compile(ModFile, Options) -> + compile_module(ModFile, Options). +compile_module(ModFile) when is_atom(ModFile); + is_list(ModFile) -> + compile_module(ModFile, []). +compile_module(Module, Options) when is_atom(Module), is_list(Options) -> + compile_module(atom_to_list(Module), Options); +compile_module(File, Options) when is_list(File), is_list(Options) -> + WithExt = case filename:extension(File) of + ".erl" -> + File; + _ -> + File++".erl" + end, + AbsFile = filename:absname(WithExt), + [R] = compile_modules([AbsFile], Options), + R. + +%% compile_directory() -> +%% compile_directory(Dir) -> +%% compile_directory(Dir, Options) -> [Result] | {error,Reason} +%% Dir = string() +%% Options - see compile/1 +%% Result - see compile/1 +%% Reason = eacces | enoent +compile_directory() -> + case file:get_cwd() of + {ok, Dir} -> + compile_directory(Dir, []); + Error -> + Error + end. +compile_directory(Dir) when is_list(Dir) -> + compile_directory(Dir, []). +compile_directory(Dir, Options) when is_list(Dir), is_list(Options) -> + case file:list_dir(Dir) of + {ok, Files} -> + + %% Filter out all erl files (except cover.erl) + ErlFileNames = + lists:filter(fun("cover.erl") -> + false; + (File) -> + case filename:extension(File) of + ".erl" -> true; + _ -> false + end + end, + Files), + + %% Create a list of .erl file names (incl path) and call + %% compile_modules/2 with the list of file names. + ErlFiles = lists:map(fun(ErlFileName) -> + filename:join(Dir, ErlFileName) + end, + ErlFileNames), + compile_modules(ErlFiles, Options); + Error -> + Error + end. + +compile_modules(Files,Options) -> + Options2 = lists:filter(fun(Option) -> + case Option of + {i, Dir} when is_list(Dir) -> true; + {d, _Macro} -> true; + {d, _Macro, _Value} -> true; + _ -> false + end + end, + Options), + compile_modules(Files,Options2,[]). + +compile_modules([File|Files], Options, Result) -> + R = call({compile, File, Options}), + compile_modules(Files,Options,[R|Result]); +compile_modules([],_Opts,Result) -> + reverse(Result). + + +%% compile_beam(ModFile) -> Result | {error,Reason} +%% ModFile - see compile/1 +%% Result - see compile/1 +%% Reason = non_existing | already_cover_compiled +compile_beam(Module) when is_atom(Module) -> + case code:which(Module) of + non_existing -> + {error,non_existing}; + ?TAG -> + compile_beam(Module,?TAG); + File -> + compile_beam(Module,File) + end; +compile_beam(File) when is_list(File) -> + {WithExt,WithoutExt} + = case filename:rootname(File,".beam") of + File -> + {File++".beam",File}; + Rootname -> + {File,Rootname} + end, + AbsFile = filename:absname(WithExt), + Module = list_to_atom(filename:basename(WithoutExt)), + compile_beam(Module,AbsFile). + +compile_beam(Module,File) -> + call({compile_beam,Module,File}). + + + +%% compile_beam_directory(Dir) -> [Result] | {error,Reason} +%% Dir - see compile_directory/1 +%% Result - see compile/1 +%% Reason = eacces | enoent +compile_beam_directory() -> + case file:get_cwd() of + {ok, Dir} -> + compile_beam_directory(Dir); + Error -> + Error + end. +compile_beam_directory(Dir) when is_list(Dir) -> + case file:list_dir(Dir) of + {ok, Files} -> + + %% Filter out all beam files (except cover.beam) + BeamFileNames = + lists:filter(fun("cover.beam") -> + false; + (File) -> + case filename:extension(File) of + ".beam" -> true; + _ -> false + end + end, + Files), + + %% Create a list of .beam file names (incl path) and call + %% compile_beam/1 for each such file name + BeamFiles = lists:map(fun(BeamFileName) -> + filename:join(Dir, BeamFileName) + end, + BeamFileNames), + compile_beams(BeamFiles); + Error -> + Error + end. + +compile_beams(Files) -> + compile_beams(Files,[]). +compile_beams([File|Files],Result) -> + R = compile_beam(File), + compile_beams(Files,[R|Result]); +compile_beams([],Result) -> + reverse(Result). + + +%% analyse(Module) -> +%% analyse(Module, Analysis) -> +%% analyse(Module, Level) -> +%% analyse(Module, Analysis, Level) -> {ok,Answer} | {error,Error} +%% Module = atom() +%% Analysis = coverage | calls +%% Level = line | clause | function | module +%% Answer = {Module,Value} | [{Item,Value}] +%% Item = Line | Clause | Function +%% Line = {M,N} +%% Clause = {M,F,A,C} +%% Function = {M,F,A} +%% M = F = atom() +%% N = A = C = integer() +%% Value = {Cov,NotCov} | Calls +%% Cov = NotCov = Calls = integer() +%% Error = {not_cover_compiled,Module} +analyse(Module) -> + analyse(Module, coverage). +analyse(Module, Analysis) when Analysis=:=coverage; Analysis=:=calls -> + analyse(Module, Analysis, function); +analyse(Module, Level) when Level=:=line; Level=:=clause; Level=:=function; + Level=:=module -> + analyse(Module, coverage, Level). +analyse(Module, Analysis, Level) when is_atom(Module), + Analysis=:=coverage; Analysis=:=calls, + Level=:=line; Level=:=clause; + Level=:=function; Level=:=module -> + call({{analyse, Analysis, Level}, Module}). + +analyze(Module) -> analyse(Module). +analyze(Module, Analysis) -> analyse(Module, Analysis). +analyze(Module, Analysis, Level) -> analyse(Module, Analysis, Level). + +%% analyse_to_file(Module) -> +%% analyse_to_file(Module, Options) -> +%% analyse_to_file(Module, OutFile) -> +%% analyse_to_file(Module, OutFile, Options) -> {ok,OutFile} | {error,Error} +%% Module = atom() +%% OutFile = string() +%% Options = [Option] +%% Option = html +%% Error = {not_cover_compiled,Module} | no_source_code_found | +%% {file,File,Reason} +%% File = string() +%% Reason = term() +analyse_to_file(Module) when is_atom(Module) -> + analyse_to_file(Module, outfilename(Module,[]), []). +analyse_to_file(Module, []) when is_atom(Module) -> + analyse_to_file(Module, outfilename(Module,[]), []); +analyse_to_file(Module, Options) when is_atom(Module), + is_list(Options), is_atom(hd(Options)) -> + analyse_to_file(Module, outfilename(Module,Options), Options); +analyse_to_file(Module, OutFile) when is_atom(Module), is_list(OutFile) -> + analyse_to_file(Module, OutFile, []). +analyse_to_file(Module, OutFile, Options) when is_atom(Module), is_list(OutFile) -> + call({{analyse_to_file, OutFile, Options}, Module}). + +analyze_to_file(Module) -> analyse_to_file(Module). +analyze_to_file(Module, OptOrOut) -> analyse_to_file(Module, OptOrOut). +analyze_to_file(Module, OutFile, Options) -> + analyse_to_file(Module, OutFile, Options). + +outfilename(Module,Opts) -> + case lists:member(html,Opts) of + true -> + atom_to_list(Module)++".COVER.html"; + false -> + atom_to_list(Module)++".COVER.out" + end. + +%% export(File) +%% export(File,Module) -> ok | {error,Reason} +%% File = string(); file to write the exported data to +%% Module = atom() +export(File) -> + export(File, '_'). +export(File, Module) -> + call({export,File,Module}). + +%% import(File) -> ok | {error, Reason} +%% File = string(); file created with cover:export/1,2 +import(File) -> + call({import,File}). + +%% modules() -> [Module] +%% Module = atom() +modules() -> + call(modules). + +%% imported_modules() -> [Module] +%% Module = atom() +imported_modules() -> + call(imported_modules). + +%% imported() -> [ImportFile] +%% ImportFile = string() +imported() -> + call(imported). + +%% which_nodes() -> [Node] +%% Node = atom() +which_nodes() -> + call(which_nodes). + +%% is_compiled(Module) -> {file,File} | false +%% Module = atom() +%% File = string() +is_compiled(Module) when is_atom(Module) -> + call({is_compiled, Module}). + +%% reset(Module) -> ok | {error,Error} +%% reset() -> ok +%% Module = atom() +%% Error = {not_cover_compiled,Module} +reset(Module) when is_atom(Module) -> + call({reset, Module}). +reset() -> + call(reset). + +%% stop() -> ok +stop() -> + call(stop). + +stop(Node) when is_atom(Node) -> + stop([Node]); +stop(Nodes) -> + call({stop,remove_myself(Nodes,[])}). + +%% bump(Module, Function, Arity, Clause, Line) +%% Module = Function = atom() +%% Arity = Clause = Line = integer() +%% This function is inserted into Cover compiled modules, once for each +%% executable line. +%bump(Module, Function, Arity, Clause, Line) -> +% Key = #bump{module=Module, function=Function, arity=Arity, clause=Clause, +% line=Line}, +% ets:update_counter(?COVER_TABLE, Key, 1). + +call(Request) -> + Ref = erlang:monitor(process,?SERVER), + receive {'DOWN', Ref, _Type, _Object, noproc} -> + erlang:demonitor(Ref), + start(), + call(Request) + after 0 -> + ?SERVER ! {self(),Request}, + Return = + receive + {'DOWN', Ref, _Type, _Object, Info} -> + exit(Info); + {?SERVER,Reply} -> + Reply + end, + erlang:demonitor(Ref), + Return + end. + +reply(From, Reply) -> + From ! {?SERVER,Reply}. +is_from(From) -> + is_pid(From). + +remote_call(Node,Request) -> + Ref = erlang:monitor(process,{?SERVER,Node}), + receive {'DOWN', Ref, _Type, _Object, noproc} -> + erlang:demonitor(Ref), + {error,node_dead} + after 0 -> + {?SERVER,Node} ! Request, + Return = + receive + {'DOWN', Ref, _Type, _Object, _Info} -> + {error,node_dead}; + {?SERVER,Reply} -> + Reply + end, + erlang:demonitor(Ref), + Return + end. + +remote_reply(MainNode,Reply) -> + {?SERVER,MainNode} ! {?SERVER,Reply}. + +%%%---------------------------------------------------------------------- +%%% cover_server on main node +%%%---------------------------------------------------------------------- + +init_main(Starter) -> + register(?SERVER,self()), + ets:new(?COVER_TABLE, [set, public, named_table]), + ets:new(?BINARY_TABLE, [set, named_table]), + ets:new(?COLLECTION_TABLE, [set, public, named_table]), + process_flag(trap_exit,true), + Starter ! {?SERVER,started}, + main_process_loop(#main_state{}). + +main_process_loop(State) -> + receive + {From, {start_nodes,Nodes}} -> + ThisNode = node(), + StartedNodes = + lists:foldl( + fun(Node,Acc) -> + case rpc:call(Node,cover,remote_start,[ThisNode]) of + {ok,RPid} -> + link(RPid), + [Node|Acc]; + Error -> + io:format("Could not start cover on ~w: ~p\n", + [Node,Error]), + Acc + end + end, + [], + Nodes), + + %% In case some of the compiled modules have been unloaded they + %% should not be loaded on the new node. + {_LoadedModules,Compiled} = + get_compiled_still_loaded(State#main_state.nodes, + State#main_state.compiled), + remote_load_compiled(StartedNodes,Compiled), + + State1 = + State#main_state{nodes = State#main_state.nodes ++ StartedNodes, + compiled = Compiled}, + reply(From, {ok,StartedNodes}), + main_process_loop(State1); + + {From, {compile, File, Options}} -> + case do_compile(File, Options) of + {ok, Module} -> + remote_load_compiled(State#main_state.nodes,[{Module,File}]), + reply(From, {ok, Module}), + Compiled = add_compiled(Module, File, + State#main_state.compiled), + Imported = remove_imported(Module,State#main_state.imported), + main_process_loop(State#main_state{compiled = Compiled, + imported = Imported}); + error -> + reply(From, {error, File}), + main_process_loop(State) + end; + + {From, {compile_beam, Module, BeamFile0}} -> + Compiled0 = State#main_state.compiled, + case get_beam_file(Module,BeamFile0,Compiled0) of + {ok,BeamFile} -> + {Reply,Compiled} = + case do_compile_beam(Module,BeamFile) of + {ok, Module} -> + remote_load_compiled(State#main_state.nodes, + [{Module,BeamFile}]), + C = add_compiled(Module,BeamFile,Compiled0), + {{ok,Module},C}; + error -> + {{error, BeamFile}, Compiled0}; + {error,Reason} -> % no abstract code + {{error, {Reason, BeamFile}}, Compiled0} + end, + reply(From,Reply), + Imported = remove_imported(Module,State#main_state.imported), + main_process_loop(State#main_state{compiled = Compiled, + imported = Imported}); + {error,no_beam} -> + %% The module has first been compiled from .erl, and now + %% someone tries to compile it from .beam + reply(From, + {error,{already_cover_compiled,no_beam_found,Module}}), + main_process_loop(State) + end; + + {From, {export,OutFile,Module}} -> + case file:open(OutFile,[write,binary,raw]) of + {ok,Fd} -> + Reply = + case Module of + '_' -> + export_info(State#main_state.imported), + collect(State#main_state.nodes), + do_export_table(State#main_state.compiled, + State#main_state.imported, + Fd); + _ -> + export_info(Module,State#main_state.imported), + case is_loaded(Module, State) of + {loaded, File} -> + [{Module,Clauses}] = + ets:lookup(?COVER_TABLE,Module), + collect(Module, Clauses, + State#main_state.nodes), + do_export_table([{Module,File}],[],Fd); + {imported, File, ImportFiles} -> + %% don't know if I should allow this - + %% export a module which is only imported + Imported = [{Module,File,ImportFiles}], + do_export_table([],Imported,Fd); + _NotLoaded -> + {error,{not_cover_compiled,Module}} + end + end, + file:close(Fd), + reply(From, Reply); + {error,Reason} -> + reply(From, {error, {cant_open_file,OutFile,Reason}}) + + end, + main_process_loop(State); + + {From, {import,File}} -> + case file:open(File,[read,binary,raw]) of + {ok,Fd} -> + Imported = do_import_to_table(Fd,File, + State#main_state.imported), + reply(From, ok), + main_process_loop(State#main_state{imported=Imported}); + {error,Reason} -> + reply(From, {error, {cant_open_file,File,Reason}}), + main_process_loop(State) + end; + + {From, modules} -> + %% Get all compiled modules which are still loaded + {LoadedModules,Compiled} = + get_compiled_still_loaded(State#main_state.nodes, + State#main_state.compiled), + + reply(From, LoadedModules), + main_process_loop(State#main_state{compiled=Compiled}); + + {From, imported_modules} -> + %% Get all modules with imported data + ImportedModules = lists:map(fun({Mod,_File,_ImportFile}) -> Mod end, + State#main_state.imported), + reply(From, ImportedModules), + main_process_loop(State); + + {From, imported} -> + %% List all imported files + reply(From, get_all_importfiles(State#main_state.imported,[])), + main_process_loop(State); + + {From, which_nodes} -> + %% List all imported files + reply(From, State#main_state.nodes), + main_process_loop(State); + + {From, reset} -> + lists:foreach( + fun({Module,_File}) -> + do_reset_main_node(Module,State#main_state.nodes) + end, + State#main_state.compiled), + reply(From, ok), + main_process_loop(State#main_state{imported=[]}); + + {From, {stop,Nodes}} -> + remote_collect('_',Nodes,true), + reply(From, ok), + State1 = State#main_state{nodes=State#main_state.nodes--Nodes}, + main_process_loop(State1); + + {From, stop} -> + lists:foreach( + fun(Node) -> + remote_call(Node,{remote,stop}) + end, + State#main_state.nodes), + reload_originals(State#main_state.compiled), + reply(From, ok); + + {From, {Request, Module}} -> + case is_loaded(Module, State) of + {loaded, File} -> + {Reply,State1} = + case Request of + {analyse, Analysis, Level} -> + analyse_info(Module,State#main_state.imported), + [{Module,Clauses}] = + ets:lookup(?COVER_TABLE,Module), + collect(Module,Clauses,State#main_state.nodes), + R = do_analyse(Module, Analysis, Level, Clauses), + {R,State}; + + {analyse_to_file, OutFile, Opts} -> + R = case find_source(File) of + {beam,_BeamFile} -> + {error,no_source_code_found}; + ErlFile -> + Imported = State#main_state.imported, + analyse_info(Module,Imported), + [{Module,Clauses}] = + ets:lookup(?COVER_TABLE,Module), + collect(Module, Clauses, + State#main_state.nodes), + HTML = lists:member(html,Opts), + do_analyse_to_file(Module,OutFile, + ErlFile,HTML) + end, + {R,State}; + + is_compiled -> + {{file, File},State}; + + reset -> + R = do_reset_main_node(Module, + State#main_state.nodes), + Imported = + remove_imported(Module, + State#main_state.imported), + {R,State#main_state{imported=Imported}} + end, + reply(From, Reply), + main_process_loop(State1); + + {imported,File,_ImportFiles} -> + {Reply,State1} = + case Request of + {analyse, Analysis, Level} -> + analyse_info(Module,State#main_state.imported), + [{Module,Clauses}] = + ets:lookup(?COLLECTION_TABLE,Module), + R = do_analyse(Module, Analysis, Level, Clauses), + {R,State}; + + {analyse_to_file, OutFile, Opts} -> + R = case find_source(File) of + {beam,_BeamFile} -> + {error,no_source_code_found}; + ErlFile -> + Imported = State#main_state.imported, + analyse_info(Module,Imported), + HTML = lists:member(html,Opts), + do_analyse_to_file(Module,OutFile, + ErlFile,HTML) + end, + {R,State}; + + is_compiled -> + {false,State}; + + reset -> + R = do_reset_collection_table(Module), + Imported = + remove_imported(Module, + State#main_state.imported), + {R,State#main_state{imported=Imported}} + end, + reply(From, Reply), + main_process_loop(State1); + + NotLoaded -> + Reply = + case Request of + is_compiled -> + false; + _ -> + {error, {not_cover_compiled,Module}} + end, + Compiled = + case NotLoaded of + unloaded -> + do_clear(Module), + remote_unload(State#main_state.nodes,[Module]), + update_compiled([Module], + State#main_state.compiled); + false -> + State#main_state.compiled + end, + reply(From, Reply), + main_process_loop(State#main_state{compiled=Compiled}) + end; + + {'EXIT',Pid,_Reason} -> + %% Exit is trapped on the main node only, so this will only happen + %% there. I assume that I'm only linked to cover_servers on remote + %% nodes, so this must be one of them crashing. + %% Remove node from list! + State1 = State#main_state{nodes=State#main_state.nodes--[node(Pid)]}, + main_process_loop(State1); + + get_status -> + io:format("~p~n",[State]), + main_process_loop(State) + end. + + + + + +%%%---------------------------------------------------------------------- +%%% cover_server on remote node +%%%---------------------------------------------------------------------- + +init_remote(Starter,MainNode) -> + register(?SERVER,self()), + ets:new(?COVER_TABLE, [set, public, named_table]), + Starter ! {self(),started}, + remote_process_loop(#remote_state{main_node=MainNode}). + + + +remote_process_loop(State) -> + receive + {remote,load_compiled,Compiled} -> + Compiled1 = load_compiled(Compiled,State#remote_state.compiled), + remote_reply(State#remote_state.main_node, ok), + remote_process_loop(State#remote_state{compiled=Compiled1}); + + {remote,unload,UnloadedModules} -> + unload(UnloadedModules), + Compiled = + update_compiled(UnloadedModules, State#remote_state.compiled), + remote_reply(State#remote_state.main_node, ok), + remote_process_loop(State#remote_state{compiled=Compiled}); + + {remote,reset,Module} -> + do_reset(Module), + remote_reply(State#remote_state.main_node, ok), + remote_process_loop(State); + + {remote,collect,Module,CollectorPid} -> + MS = + case Module of + '_' -> ets:fun2ms(fun({M,C}) when is_atom(M) -> C end); + _ -> ets:fun2ms(fun({M,C}) when M=:=Module -> C end) + end, + AllClauses = lists:flatten(ets:select(?COVER_TABLE,MS)), + + %% Sending clause by clause in order to avoid large lists + lists:foreach( + fun({M,F,A,C,_L}) -> + Pattern = + {#bump{module=M, function=F, arity=A, clause=C}, '_'}, + Bumps = ets:match_object(?COVER_TABLE, Pattern), + %% Reset + lists:foreach(fun({Bump,_N}) -> + ets:insert(?COVER_TABLE, {Bump,0}) + end, + Bumps), + CollectorPid ! {chunk,Bumps} + end, + AllClauses), + CollectorPid ! done, + remote_reply(State#remote_state.main_node, ok), + remote_process_loop(State); + + {remote,stop} -> + reload_originals(State#remote_state.compiled), + remote_reply(State#remote_state.main_node, ok); + + get_status -> + io:format("~p~n",[State]), + remote_process_loop(State); + + M -> + io:format("WARNING: remote cover_server received\n~p\n",[M]), + case M of + {From,_} -> + case is_from(From) of + true -> + reply(From,{error,not_main_node}); + false -> + ok + end; + _ -> + ok + end, + remote_process_loop(State) + + end. + + +reload_originals([{Module,_File}|Compiled]) -> + do_reload_original(Module), + reload_originals(Compiled); +reload_originals([]) -> + ok. + +do_reload_original(Module) -> + case code:which(Module) of + ?TAG -> + code:purge(Module), % remove code marked as 'old' + code:delete(Module), % mark cover compiled code as 'old' + %% Note: original beam code must be loaded before the cover + %% compiled code is purged, in order to for references to + %% 'fun M:F/A' and %% 'fun F/A' funs to be correct (they + %% refer to (M:)F/A in the *latest* version of the module) + code:load_file(Module), % load original code + code:purge(Module); % remove cover compiled code + _ -> + ignore + end. + +load_compiled([{Module,File,Binary,InitialTable}|Compiled],Acc) -> + %% Make sure the #bump{} records are available *before* the + %% module is loaded. + insert_initial_data(InitialTable), + NewAcc = + case code:load_binary(Module, ?TAG, Binary) of + {module,Module} -> + add_compiled(Module, File, Acc); + _ -> + do_clear(Module), + Acc + end, + load_compiled(Compiled,NewAcc); +load_compiled([],Acc) -> + Acc. + +insert_initial_data([Item|Items]) -> + ets:insert(?COVER_TABLE, Item), + insert_initial_data(Items); +insert_initial_data([]) -> + ok. + + +unload([Module|Modules]) -> + do_clear(Module), + do_reload_original(Module), + unload(Modules); +unload([]) -> + ok. + +%%%---------------------------------------------------------------------- +%%% Internal functions +%%%---------------------------------------------------------------------- + +%%%--Handling of remote nodes-------------------------------------------- + +%% start the cover_server on a remote node +remote_start(MainNode) -> + case whereis(?SERVER) of + undefined -> + Starter = self(), + Pid = spawn(fun() -> init_remote(Starter,MainNode) end), + Ref = erlang:monitor(process,Pid), + Return = + receive + {Pid,started} -> + {ok,Pid}; + {'DOWN', Ref, _Type, _Object, Info} -> + {error,Info} + end, + erlang:demonitor(Ref), + Return; + Pid -> + {error,{already_started,Pid}} + end. + +%% Load a set of cover compiled modules on remote nodes +remote_load_compiled(Nodes,Compiled0) -> + Compiled = lists:map(fun get_data_for_remote_loading/1,Compiled0), + lists:foreach( + fun(Node) -> + remote_call(Node,{remote,load_compiled,Compiled}) + end, + Nodes). + +%% Read all data needed for loading a cover compiled module on a remote node +%% Binary is the beam code for the module and InitialTable is the initial +%% data to insert in ?COVER_TABLE. +get_data_for_remote_loading({Module,File}) -> + [{Module,Binary}] = ets:lookup(?BINARY_TABLE,Module), + %%! The InitialTable list will be long if the module is big - what to do?? + InitialTable = ets:select(?COVER_TABLE,ms(Module)), + {Module,File,Binary,InitialTable}. + +%% Create a match spec which returns the clause info {Module,InitInfo} and +%% all #bump keys for the given module with 0 number of calls. +ms(Module) -> + ets:fun2ms(fun({Module,InitInfo}) -> + {Module,InitInfo}; + ({Key,_}) when is_record(Key,bump),Key#bump.module=:=Module -> + {Key,0} + end). + +%% Unload modules on remote nodes +remote_unload(Nodes,UnloadedModules) -> + lists:foreach( + fun(Node) -> + remote_call(Node,{remote,unload,UnloadedModules}) + end, + Nodes). + +%% Reset one or all modules on remote nodes +remote_reset(Module,Nodes) -> + lists:foreach( + fun(Node) -> + remote_call(Node,{remote,reset,Module}) + end, + Nodes). + +%% Collect data from remote nodes - used for analyse or stop(Node) +remote_collect(Module,Nodes,Stop) -> + CollectorPid = spawn(fun() -> collector_proc(length(Nodes)) end), + lists:foreach( + fun(Node) -> + remote_call(Node,{remote,collect,Module,CollectorPid}), + if Stop -> remote_call(Node,{remote,stop}); + true -> ok + end + end, + Nodes). + +%% Process which receives chunks of data from remote nodes - either when +%% analysing or when stopping cover on the remote nodes. +collector_proc(0) -> + ok; +collector_proc(N) -> + receive + {chunk,Chunk} -> + insert_in_collection_table(Chunk), + collector_proc(N); + done -> + collector_proc(N-1) + end. + +insert_in_collection_table([{Key,Val}|Chunk]) -> + insert_in_collection_table(Key,Val), + insert_in_collection_table(Chunk); +insert_in_collection_table([]) -> + ok. + +insert_in_collection_table(Key,Val) -> + case ets:member(?COLLECTION_TABLE,Key) of + true -> + ets:update_counter(?COLLECTION_TABLE, + Key,Val); + false -> + ets:insert(?COLLECTION_TABLE,{Key,Val}) + end. + + +remove_myself([Node|Nodes],Acc) when Node=:=node() -> + remove_myself(Nodes,Acc); +remove_myself([Node|Nodes],Acc) -> + remove_myself(Nodes,[Node|Acc]); +remove_myself([],Acc) -> + Acc. + + +%%%--Handling of modules state data-------------------------------------- + +analyse_info(_Module,[]) -> + ok; +analyse_info(Module,Imported) -> + imported_info("Analysis",Module,Imported). + +export_info(_Module,[]) -> + ok; +export_info(Module,Imported) -> + imported_info("Export",Module,Imported). + +export_info([]) -> + ok; +export_info(Imported) -> + AllImportFiles = get_all_importfiles(Imported,[]), + io:format("Export includes data from imported files\n~p\n",[AllImportFiles]). + +get_all_importfiles([{_M,_F,ImportFiles}|Imported],Acc) -> + NewAcc = do_get_all_importfiles(ImportFiles,Acc), + get_all_importfiles(Imported,NewAcc); +get_all_importfiles([],Acc) -> + Acc. + +do_get_all_importfiles([ImportFile|ImportFiles],Acc) -> + case lists:member(ImportFile,Acc) of + true -> + do_get_all_importfiles(ImportFiles,Acc); + false -> + do_get_all_importfiles(ImportFiles,[ImportFile|Acc]) + end; +do_get_all_importfiles([],Acc) -> + Acc. + +imported_info(Text,Module,Imported) -> + case lists:keysearch(Module,1,Imported) of + {value,{Module,_File,ImportFiles}} -> + io:format("~s includes data from imported files\n~p\n", + [Text,ImportFiles]); + false -> + ok + end. + + + +add_imported(Module, File, ImportFile, Imported) -> + add_imported(Module, File, filename:absname(ImportFile), Imported, []). + +add_imported(M, F1, ImportFile, [{M,_F2,ImportFiles}|Imported], Acc) -> + case lists:member(ImportFile,ImportFiles) of + true -> + io:fwrite("WARNING: Module ~w already imported from ~p~n" + "Not importing again!~n",[M,ImportFile]), + dont_import; + false -> + NewEntry = {M, F1, [ImportFile | ImportFiles]}, + {ok, reverse([NewEntry | Acc]) ++ Imported} + end; +add_imported(M, F, ImportFile, [H|Imported], Acc) -> + add_imported(M, F, ImportFile, Imported, [H|Acc]); +add_imported(M, F, ImportFile, [], Acc) -> + {ok, reverse([{M, F, [ImportFile]} | Acc])}. + +%% Removes a module from the list of imported modules and writes a warning +%% This is done when a module is compiled. +remove_imported(Module,Imported) -> + case lists:keysearch(Module,1,Imported) of + {value,{Module,_,ImportFiles}} -> + io:fwrite("WARNING: Deleting data for module ~w imported from~n" + "~p~n",[Module,ImportFiles]), + lists:keydelete(Module,1,Imported); + false -> + Imported + end. + +%% Adds information to the list of compiled modules, preserving time order +%% and without adding duplicate entries. +add_compiled(Module, File1, [{Module,_File2}|Compiled]) -> + [{Module,File1}|Compiled]; +add_compiled(Module, File, [H|Compiled]) -> + [H|add_compiled(Module, File, Compiled)]; +add_compiled(Module, File, []) -> + [{Module,File}]. + +is_loaded(Module, State) -> + case get_file(Module, State#main_state.compiled) of + {ok, File} -> + case code:which(Module) of + ?TAG -> {loaded, File}; + _ -> unloaded + end; + false -> + case get_file(Module,State#main_state.imported) of + {ok,File,ImportFiles} -> + {imported, File, ImportFiles}; + false -> + false + end + end. + +get_file(Module, [{Module, File}|_T]) -> + {ok, File}; +get_file(Module, [{Module, File, ImportFiles}|_T]) -> + {ok, File, ImportFiles}; +get_file(Module, [_H|T]) -> + get_file(Module, T); +get_file(_Module, []) -> + false. + +get_beam_file(Module,?TAG,Compiled) -> + {value,{Module,File}} = lists:keysearch(Module,1,Compiled), + case filename:extension(File) of + ".erl" -> {error,no_beam}; + ".beam" -> {ok,File} + end; +get_beam_file(_Module,BeamFile,_Compiled) -> + {ok,BeamFile}. + +get_modules(Compiled) -> + lists:map(fun({Module, _File}) -> Module end, Compiled). + +update_compiled([Module|Modules], [{Module,_File}|Compiled]) -> + update_compiled(Modules, Compiled); +update_compiled(Modules, [H|Compiled]) -> + [H|update_compiled(Modules, Compiled)]; +update_compiled(_Modules, []) -> + []. + +%% Get all compiled modules which are still loaded, and possibly an +%% updated version of the Compiled list. +get_compiled_still_loaded(Nodes,Compiled0) -> + %% Find all Cover compiled modules which are still loaded + CompiledModules = get_modules(Compiled0), + LoadedModules = lists:filter(fun(Module) -> + case code:which(Module) of + ?TAG -> true; + _ -> false + end + end, + CompiledModules), + + %% If some Cover compiled modules have been unloaded, update the database. + UnloadedModules = CompiledModules--LoadedModules, + Compiled = + case UnloadedModules of + [] -> + Compiled0; + _ -> + lists:foreach(fun(Module) -> do_clear(Module) end, + UnloadedModules), + remote_unload(Nodes,UnloadedModules), + update_compiled(UnloadedModules, Compiled0) + end, + {LoadedModules,Compiled}. + + +%%%--Compilation--------------------------------------------------------- + +%% do_compile(File, Options) -> {ok,Module} | {error,Error} +do_compile(File, UserOptions) -> + Options = [debug_info,binary,report_errors,report_warnings] ++ UserOptions, + case compile:file(File, Options) of + {ok, Module, Binary} -> + do_compile_beam(Module,Binary); + error -> + error + end. + +%% Beam is a binary or a .beam file name +do_compile_beam(Module,Beam) -> + %% Clear database + do_clear(Module), + + %% Extract the abstract format and insert calls to bump/6 at + %% every executable line and, as a side effect, initiate + %% the database + + case get_abstract_code(Module, Beam) of + no_abstract_code=E -> + {error,E}; + encrypted_abstract_code=E -> + {error,E}; + {Vsn,Code} -> + Forms0 = epp:interpret_file_attribute(Code), + {Forms,Vars} = transform(Vsn, Forms0, Module, Beam), + + %% Compile and load the result + %% It's necessary to check the result of loading since it may + %% fail, for example if Module resides in a sticky directory + {ok, Module, Binary} = compile:forms(Forms, []), + case code:load_binary(Module, ?TAG, Binary) of + {module, Module} -> + + %% Store info about all function clauses in database + InitInfo = reverse(Vars#vars.init_info), + ets:insert(?COVER_TABLE, {Module, InitInfo}), + + %% Store binary code so it can be loaded on remote nodes + ets:insert(?BINARY_TABLE, {Module, Binary}), + + {ok, Module}; + + _Error -> + do_clear(Module), + error + end + end. + +get_abstract_code(Module, Beam) -> + case beam_lib:chunks(Beam, [abstract_code]) of + {ok, {Module, [{abstract_code, AbstractCode}]}} -> + AbstractCode; + {error,beam_lib,{key_missing_or_invalid,_,_}} -> + encrypted_abstract_code; + Error -> Error + end. + +transform(Vsn, Code, Module, Beam) when Vsn=:=abstract_v1; Vsn=:=abstract_v2 -> + Vars0 = #vars{module=Module, vsn=Vsn}, + MainFile=find_main_filename(Code), + {ok, MungedForms,Vars} = transform_2(Code,[],Vars0,MainFile,on), + + %% Add module and export information to the munged forms + %% Information about module_info must be removed as this function + %% is added at compilation + {ok, {Module, [{exports,Exports1}]}} = beam_lib:chunks(Beam, [exports]), + Exports2 = lists:filter(fun(Export) -> + case Export of + {module_info,_} -> false; + _ -> true + end + end, + Exports1), + Forms = [{attribute,1,module,Module}, + {attribute,2,export,Exports2}]++ MungedForms, + {Forms,Vars}; +transform(Vsn=raw_abstract_v1, Code, Module, _Beam) -> + MainFile=find_main_filename(Code), + Vars0 = #vars{module=Module, vsn=Vsn}, + {ok,MungedForms,Vars} = transform_2(Code,[],Vars0,MainFile,on), + {MungedForms,Vars}. + +%% Helpfunction which returns the first found file-attribute, which can +%% be interpreted as the name of the main erlang source file. +find_main_filename([{attribute,_,file,{MainFile,_}}|_]) -> + MainFile; +find_main_filename([_|Rest]) -> + find_main_filename(Rest). + +transform_2([Form0|Forms],MungedForms,Vars,MainFile,Switch) -> + Form = expand(Form0), + case munge(Form,Vars,MainFile,Switch) of + ignore -> + transform_2(Forms,MungedForms,Vars,MainFile,Switch); + {MungedForm,Vars2,NewSwitch} -> + transform_2(Forms,[MungedForm|MungedForms],Vars2,MainFile,NewSwitch) + end; +transform_2([],MungedForms,Vars,_,_) -> + {ok, reverse(MungedForms), Vars}. + +%% Expand short-circuit Boolean expressions. +expand(Expr) -> + AllVars = sets:from_list(ordsets:to_list(vars([], Expr))), + {Expr1,_} = expand(Expr, AllVars, 1), + Expr1. + +expand({clause,Line,Pattern,Guards,Body}, Vs, N) -> + {ExpandedBody,N2} = expand(Body, Vs, N), + {{clause,Line,Pattern,Guards,ExpandedBody},N2}; +expand({op,_Line,'andalso',ExprL,ExprR}, Vs, N) -> + {ExpandedExprL,N2} = expand(ExprL, Vs, N), + {ExpandedExprR,N3} = expand(ExprR, Vs, N2), + LineL = element(2, ExpandedExprL), + {bool_switch(ExpandedExprL, + ExpandedExprR, + {atom,LineL,false}, + Vs, N3), + N3 + 1}; +expand({op,_Line,'orelse',ExprL,ExprR}, Vs, N) -> + {ExpandedExprL,N2} = expand(ExprL, Vs, N), + {ExpandedExprR,N3} = expand(ExprR, Vs, N2), + LineL = element(2, ExpandedExprL), + {bool_switch(ExpandedExprL, + {atom,LineL,true}, + ExpandedExprR, + Vs, N3), + N3 + 1}; +expand(T, Vs, N) when is_tuple(T) -> + {TL,N2} = expand(tuple_to_list(T), Vs, N), + {list_to_tuple(TL),N2}; +expand([E|Es], Vs, N) -> + {E2,N2} = expand(E, Vs, N), + {Es2,N3} = expand(Es, Vs, N2), + {[E2|Es2],N3}; +expand(T, _Vs, N) -> + {T,N}. + +vars(A, {var,_,V}) when V =/= '_' -> + [V|A]; +vars(A, T) when is_tuple(T) -> + vars(A, tuple_to_list(T)); +vars(A, [E|Es]) -> + vars(vars(A, E), Es); +vars(A, _T) -> + A. + +bool_switch(E, T, F, AllVars, AuxVarN) -> + Line = element(2, E), + AuxVar = {var,Line,aux_var(AllVars, AuxVarN)}, + {'case',Line,E, + [{clause,Line,[{atom,Line,true}],[],[T]}, + {clause,Line,[{atom,Line,false}],[],[F]}, + {clause,Line,[AuxVar],[], + [{call,Line, + {remote,Line,{atom,Line,erlang},{atom,Line,error}}, + [{tuple,Line,[{atom,Line,badarg},AuxVar]}]}]}]}. + +aux_var(Vars, N) -> + Name = list_to_atom(lists:concat(['_', N])), + case sets:is_element(Name, Vars) of + true -> aux_var(Vars, N + 1); + false -> Name + end. + +%% This code traverses the abstract code, stored as the abstract_code +%% chunk in the BEAM file, as described in absform(3) for Erlang/OTP R8B +%% (Vsn=abstract_v2). +%% The abstract format after preprocessing differs slightly from the abstract +%% format given eg using epp:parse_form, this has been noted in comments. +%% The switch is turned off when we encounter other files then the main file. +%% This way we will be able to exclude functions defined in include files. +munge({function,0,module_info,_Arity,_Clauses},_Vars,_MainFile,_Switch) -> + ignore; % module_info will be added again when the forms are recompiled +munge(Form={function,_,'MNEMOSYNE QUERY',_,_},Vars,_MainFile,Switch) -> + {Form,Vars,Switch}; % No bumps in Mnemosyne code. +munge(Form={function,_,'MNEMOSYNE RULE',_,_},Vars,_MainFile,Switch) -> + {Form,Vars,Switch}; +munge(Form={function,_,'MNEMOSYNE RECFUNDEF',_,_},Vars,_MainFile,Switch) -> + {Form,Vars,Switch}; +munge({function,Line,Function,Arity,Clauses},Vars,_MainFile,on) -> + Vars2 = Vars#vars{function=Function, + arity=Arity, + clause=1, + lines=[], + no_bump_lines=[], + depth=1}, + {MungedClauses, Vars3} = munge_clauses(Clauses, Vars2), + {{function,Line,Function,Arity,MungedClauses},Vars3,on}; +munge(Form={attribute,_,file,{MainFile,_}},Vars,MainFile,_Switch) -> + {Form,Vars,on}; % Switch on tranformation! +munge(Form={attribute,_,file,{_InclFile,_}},Vars,_MainFile,_Switch) -> + {Form,Vars,off}; % Switch off transformation! +munge({attribute,_,compile,{parse_transform,_}},_Vars,_MainFile,_Switch) -> + %% Don't want to run parse transforms more than once. + ignore; +munge(Form,Vars,_MainFile,Switch) -> % Other attributes and skipped includes. + {Form,Vars,Switch}. + +munge_clauses(Clauses, Vars) -> + munge_clauses(Clauses, Vars, Vars#vars.lines, []). + +munge_clauses([Clause|Clauses], Vars, Lines, MClauses) -> + {clause,Line,Pattern,Guards,Body} = Clause, + {MungedGuards, _Vars} = munge_exprs(Guards, Vars#vars{is_guard=true},[]), + + case Vars#vars.depth of + 1 -> % function clause + {MungedBody, Vars2} = munge_body(Body, Vars#vars{depth=2}), + ClauseInfo = {Vars2#vars.module, + Vars2#vars.function, + Vars2#vars.arity, + Vars2#vars.clause, + length(Vars2#vars.lines)}, % Not used? + InitInfo = [ClauseInfo | Vars2#vars.init_info], + Vars3 = Vars2#vars{init_info=InitInfo, + clause=(Vars2#vars.clause)+1, + lines=[], + no_bump_lines=[], + depth=1}, + NewBumps = Vars2#vars.lines, + NewLines = NewBumps ++ Lines, + munge_clauses(Clauses, Vars3, NewLines, + [{clause,Line,Pattern,MungedGuards,MungedBody}| + MClauses]); + + 2 -> % receive-, case-, if-, or try-clause + Lines0 = Vars#vars.lines, + {MungedBody, Vars2} = munge_body(Body, Vars), + NewBumps = new_bumps(Vars2, Vars), + NewLines = NewBumps ++ Lines, + munge_clauses(Clauses, Vars2#vars{lines=Lines0}, + NewLines, + [{clause,Line,Pattern,MungedGuards,MungedBody}| + MClauses]) + end; +munge_clauses([], Vars, Lines, MungedClauses) -> + {reverse(MungedClauses), Vars#vars{lines = Lines}}. + +munge_body(Expr, Vars) -> + munge_body(Expr, Vars, [], []). + +munge_body([Expr|Body], Vars, MungedBody, LastExprBumpLines) -> + %% Here is the place to add a call to cover:bump/6! + Line = element(2, Expr), + Lines = Vars#vars.lines, + case lists:member(Line,Lines) of + true -> % already a bump at this line + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + NewBumps = new_bumps(Vars2, Vars), + NoBumpLines = [Line|Vars#vars.no_bump_lines], + Vars3 = Vars2#vars{no_bump_lines = NoBumpLines}, + MungedBody1 = + maybe_fix_last_expr(MungedBody, Vars3, LastExprBumpLines), + MungedExprs1 = [MungedExpr|MungedBody1], + munge_body(Body, Vars3, MungedExprs1, NewBumps); + false -> + ets:insert(?COVER_TABLE, {#bump{module = Vars#vars.module, + function = Vars#vars.function, + arity = Vars#vars.arity, + clause = Vars#vars.clause, + line = Line}, + 0}), + Bump = bump_call(Vars, Line), +% Bump = {call, 0, {remote, 0, {atom,0,cover}, {atom,0,bump}}, +% [{atom, 0, Vars#vars.module}, +% {atom, 0, Vars#vars.function}, +% {integer, 0, Vars#vars.arity}, +% {integer, 0, Vars#vars.clause}, +% {integer, 0, Line}]}, + Lines2 = [Line|Lines], + {MungedExpr, Vars2} = munge_expr(Expr, Vars#vars{lines=Lines2}), + NewBumps = new_bumps(Vars2, Vars), + NoBumpLines = subtract(Vars2#vars.no_bump_lines, NewBumps), + Vars3 = Vars2#vars{no_bump_lines = NoBumpLines}, + MungedBody1 = + maybe_fix_last_expr(MungedBody, Vars3, LastExprBumpLines), + MungedExprs1 = [MungedExpr,Bump|MungedBody1], + munge_body(Body, Vars3, MungedExprs1, NewBumps) + end; +munge_body([], Vars, MungedBody, _LastExprBumpLines) -> + {reverse(MungedBody), Vars}. + +%%% Fix last expression (OTP-8188). A typical example: +%%% +%%% 3: case X of +%%% 4: 1 -> a; % Bump line 5 after "a" has been evaluated! +%%% 5: 2 -> b; 3 -> c end, F() +%%% +%%% Line 5 wasn't bumped just before "F()" since it was already bumped +%%% before "b" (and before "c") (one mustn't bump a line more than +%%% once in a single "evaluation"). The expression "case X ... end" is +%%% now traversed again ("fixed"), this time adding bumps of line 5 +%%% where appropriate, in this case when X matches 1. +%%% +%%% This doesn't solve all problems with expressions on the same line, +%%% though. 'case' and 'try' are tricky. An example: +%%% +%%% 7: case case X of 1 -> foo(); % ? +%%% 8: 2 -> bar() end of a -> 1; +%%% 9: b -> 2 end. +%%% +%%% If X matches 1 and foo() evaluates to a then line 8 should be +%%% bumped, but not if foo() evaluates to b. In other words, line 8 +%%% cannot be bumped after "foo()" on line 7, so one has to bump line +%%% 8 before "begin 1 end". But if X matches 2 and bar evaluates to a +%%% then line 8 would be bumped twice (there has to be a bump before +%%% "bar()". It is like one would have to have two copies of the inner +%%% clauses, one for each outer clause. Maybe the munging should be +%%% done on some of the compiler's "lower level" format. +%%% +%%% 'fun' is also problematic since a bump inside the body "shadows" +%%% the rest of the line. + +maybe_fix_last_expr(MungedExprs, Vars, LastExprBumpLines) -> + case last_expr_needs_fixing(Vars, LastExprBumpLines) of + {yes, Line} -> + fix_last_expr(MungedExprs, Line, Vars); + no -> + MungedExprs + end. + +last_expr_needs_fixing(Vars, LastExprBumpLines) -> + case common_elems(Vars#vars.no_bump_lines, LastExprBumpLines) of + [Line] -> {yes, Line}; + _ -> no + end. + +fix_last_expr([MungedExpr|MungedExprs], Line, Vars) -> + %% No need to update ?COVER_TABLE. + Bump = bump_call(Vars, Line), + [fix_expr(MungedExpr, Line, Bump)|MungedExprs]. + +fix_expr({'if',L,Clauses}, Line, Bump) -> + FixedClauses = fix_clauses(Clauses, Line, Bump), + {'if',L,FixedClauses}; +fix_expr({'case',L,Expr,Clauses}, Line, Bump) -> + FixedExpr = fix_expr(Expr, Line, Bump), + FixedClauses = fix_clauses(Clauses, Line, Bump), + {'case',L,FixedExpr,FixedClauses}; +fix_expr({'receive',L,Clauses}, Line, Bump) -> + FixedClauses = fix_clauses(Clauses, Line, Bump), + {'receive',L,FixedClauses}; +fix_expr({'receive',L,Clauses,Expr,Body}, Line, Bump) -> + FixedClauses = fix_clauses(Clauses, Line, Bump), + FixedExpr = fix_expr(Expr, Line, Bump), + FixedBody = fix_expr(Body, Line, Bump), + {'receive',L,FixedClauses,FixedExpr,FixedBody}; +fix_expr({'try',L,Exprs,Clauses,CatchClauses,After}, Line, Bump) -> + FixedExprs = fix_expr(Exprs, Line, Bump), + FixedClauses = fix_clauses(Clauses, Line, Bump), + FixedCatchClauses = fix_clauses(CatchClauses, Line, Bump), + FixedAfter = fix_expr(After, Line, Bump), + {'try',L,FixedExprs,FixedClauses,FixedCatchClauses,FixedAfter}; +fix_expr([E | Es], Line, Bump) -> + [fix_expr(E, Line, Bump) | fix_expr(Es, Line, Bump)]; +fix_expr(T, Line, Bump) when is_tuple(T) -> + list_to_tuple(fix_expr(tuple_to_list(T), Line, Bump)); +fix_expr(E, _Line, _Bump) -> + E. + +fix_clauses(Cs, Line, Bump) -> + case bumps_line(lists:last(Cs), Line) of + true -> + fix_cls(Cs, Line, Bump); + false -> + Cs + end. + +fix_cls([], _Line, _Bump) -> + []; +fix_cls([Cl | Cls], Line, Bump) -> + case bumps_line(Cl, Line) of + true -> + [fix_expr(C, Line, Bump) || C <- [Cl | Cls]]; + false -> + {clause,CL,P,G,Body} = Cl, + UniqueVarName = list_to_atom(lists:concat(["$cover$ ",Line])), + V = {var,0,UniqueVarName}, + [Last|Rest] = lists:reverse(Body), + Body1 = lists:reverse(Rest, [{match,0,V,Last},Bump,V]), + [{clause,CL,P,G,Body1} | fix_cls(Cls, Line, Bump)] + end. + +bumps_line(E, L) -> + try bumps_line1(E, L) catch true -> true end. + +bumps_line1({call,0,{remote,0,{atom,0,ets},{atom,0,update_counter}}, + [{atom,0,?COVER_TABLE},{tuple,0,[_,_,_,_,_,{integer,0,Line}]},_]}, + Line) -> + throw(true); +bumps_line1([E | Es], Line) -> + bumps_line1(E, Line), + bumps_line1(Es, Line); +bumps_line1(T, Line) when is_tuple(T) -> + bumps_line1(tuple_to_list(T), Line); +bumps_line1(_, _) -> + false. + +%%% End of fix of last expression. + +bump_call(Vars, Line) -> + {call,0,{remote,0,{atom,0,ets},{atom,0,update_counter}}, + [{atom,0,?COVER_TABLE}, + {tuple,0,[{atom,0,?BUMP_REC_NAME}, + {atom,0,Vars#vars.module}, + {atom,0,Vars#vars.function}, + {integer,0,Vars#vars.arity}, + {integer,0,Vars#vars.clause}, + {integer,0,Line}]}, + {integer,0,1}]}. + +munge_expr({match,Line,ExprL,ExprR}, Vars) -> + {MungedExprL, Vars2} = munge_expr(ExprL, Vars), + {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), + {{match,Line,MungedExprL,MungedExprR}, Vars3}; +munge_expr({tuple,Line,Exprs}, Vars) -> + {MungedExprs, Vars2} = munge_exprs(Exprs, Vars, []), + {{tuple,Line,MungedExprs}, Vars2}; +munge_expr({record,Line,Expr,Exprs}, Vars) -> + %% Only for Vsn=raw_abstract_v1 + {MungedExprName, Vars2} = munge_expr(Expr, Vars), + {MungedExprFields, Vars3} = munge_exprs(Exprs, Vars2, []), + {{record,Line,MungedExprName,MungedExprFields}, Vars3}; +munge_expr({record_field,Line,ExprL,ExprR}, Vars) -> + %% Only for Vsn=raw_abstract_v1 + {MungedExprL, Vars2} = munge_expr(ExprL, Vars), + {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), + {{record_field,Line,MungedExprL,MungedExprR}, Vars3}; +munge_expr({cons,Line,ExprH,ExprT}, Vars) -> + {MungedExprH, Vars2} = munge_expr(ExprH, Vars), + {MungedExprT, Vars3} = munge_expr(ExprT, Vars2), + {{cons,Line,MungedExprH,MungedExprT}, Vars3}; +munge_expr({op,Line,Op,ExprL,ExprR}, Vars) -> + {MungedExprL, Vars2} = munge_expr(ExprL, Vars), + {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), + {{op,Line,Op,MungedExprL,MungedExprR}, Vars3}; +munge_expr({op,Line,Op,Expr}, Vars) -> + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + {{op,Line,Op,MungedExpr}, Vars2}; +munge_expr({'catch',Line,Expr}, Vars) -> + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + {{'catch',Line,MungedExpr}, Vars2}; +munge_expr({call,Line1,{remote,Line2,ExprM,ExprF},Exprs}, + Vars) when Vars#vars.is_guard=:=false-> + {MungedExprM, Vars2} = munge_expr(ExprM, Vars), + {MungedExprF, Vars3} = munge_expr(ExprF, Vars2), + {MungedExprs, Vars4} = munge_exprs(Exprs, Vars3, []), + {{call,Line1,{remote,Line2,MungedExprM,MungedExprF},MungedExprs}, Vars4}; +munge_expr({call,Line1,{remote,_Line2,_ExprM,ExprF},Exprs}, + Vars) when Vars#vars.is_guard=:=true -> + %% Difference in abstract format after preprocessing: BIF calls in guards + %% are translated to {remote,...} (which is not allowed as source form) + %% NOT NECESSARY FOR Vsn=raw_abstract_v1 + munge_expr({call,Line1,ExprF,Exprs}, Vars); +munge_expr({call,Line,Expr,Exprs}, Vars) -> + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + {MungedExprs, Vars3} = munge_exprs(Exprs, Vars2, []), + {{call,Line,MungedExpr,MungedExprs}, Vars3}; +munge_expr({lc,Line,Expr,Qs}, Vars) -> + {MungedExpr, Vars2} = munge_expr(?BLOCK1(Expr), Vars), + {MungedQs, Vars3} = munge_qualifiers(Qs, Vars2), + {{lc,Line,MungedExpr,MungedQs}, Vars3}; +munge_expr({bc,Line,Expr,Qs}, Vars) -> + {bin,BLine,[{bin_element,EL,Val,Sz,TSL}]} = Expr, + Expr2 = {bin,BLine,[{bin_element,EL,?BLOCK1(Val),Sz,TSL}]}, + {MungedExpr,Vars2} = munge_expr(Expr2, Vars), + {MungedQs, Vars3} = munge_qualifiers(Qs, Vars2), + {{bc,Line,MungedExpr,MungedQs}, Vars3}; +munge_expr({block,Line,Body}, Vars) -> + {MungedBody, Vars2} = munge_body(Body, Vars), + {{block,Line,MungedBody}, Vars2}; +munge_expr({'if',Line,Clauses}, Vars) -> + {MungedClauses,Vars2} = munge_clauses(Clauses, Vars), + {{'if',Line,MungedClauses}, Vars2}; +munge_expr({'case',Line,Expr,Clauses}, Vars) -> + {MungedExpr,Vars2} = munge_expr(Expr, Vars), + {MungedClauses,Vars3} = munge_clauses(Clauses, Vars2), + {{'case',Line,MungedExpr,MungedClauses}, Vars3}; +munge_expr({'receive',Line,Clauses}, Vars) -> + {MungedClauses,Vars2} = munge_clauses(Clauses, Vars), + {{'receive',Line,MungedClauses}, Vars2}; +munge_expr({'receive',Line,Clauses,Expr,Body}, Vars) -> + {MungedExpr, Vars1} = munge_expr(Expr, Vars), + {MungedClauses,Vars2} = munge_clauses(Clauses, Vars1), + {MungedBody,Vars3} = + munge_body(Body, Vars2#vars{lines = Vars1#vars.lines}), + Vars4 = Vars3#vars{lines = Vars2#vars.lines ++ new_bumps(Vars3, Vars2)}, + {{'receive',Line,MungedClauses,MungedExpr,MungedBody}, Vars4}; +munge_expr({'try',Line,Body,Clauses,CatchClauses,After}, Vars) -> + {MungedBody, Vars1} = munge_body(Body, Vars), + {MungedClauses, Vars2} = munge_clauses(Clauses, Vars1), + {MungedCatchClauses, Vars3} = munge_clauses(CatchClauses, Vars2), + {MungedAfter, Vars4} = munge_body(After, Vars3), + {{'try',Line,MungedBody,MungedClauses,MungedCatchClauses,MungedAfter}, + Vars4}; +%% Difference in abstract format after preprocessing: Funs get an extra +%% element Extra. +%% NOT NECESSARY FOR Vsn=raw_abstract_v1 +munge_expr({'fun',Line,{function,Name,Arity},_Extra}, Vars) -> + {{'fun',Line,{function,Name,Arity}}, Vars}; +munge_expr({'fun',Line,{clauses,Clauses},_Extra}, Vars) -> + {MungedClauses,Vars2}=munge_clauses(Clauses, Vars), + {{'fun',Line,{clauses,MungedClauses}}, Vars2}; +munge_expr({'fun',Line,{clauses,Clauses}}, Vars) -> + %% Only for Vsn=raw_abstract_v1 + {MungedClauses,Vars2}=munge_clauses(Clauses, Vars), + {{'fun',Line,{clauses,MungedClauses}}, Vars2}; +munge_expr({bin,Line,BinElements}, Vars) -> + {MungedBinElements,Vars2} = munge_exprs(BinElements, Vars, []), + {{bin,Line,MungedBinElements}, Vars2}; +munge_expr({bin_element,Line,Value,Size,TypeSpecifierList}, Vars) -> + {MungedValue,Vars2} = munge_expr(Value, Vars), + {MungedSize,Vars3} = munge_expr(Size, Vars2), + {{bin_element,Line,MungedValue,MungedSize,TypeSpecifierList},Vars3}; +munge_expr(Form, Vars) -> % var|char|integer|float|string|atom|nil|eof|default + {Form, Vars}. + +munge_exprs([Expr|Exprs], Vars, MungedExprs) when Vars#vars.is_guard=:=true, + is_list(Expr) -> + {MungedExpr, _Vars} = munge_exprs(Expr, Vars, []), + munge_exprs(Exprs, Vars, [MungedExpr|MungedExprs]); +munge_exprs([Expr|Exprs], Vars, MungedExprs) -> + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + munge_exprs(Exprs, Vars2, [MungedExpr|MungedExprs]); +munge_exprs([], Vars, MungedExprs) -> + {reverse(MungedExprs), Vars}. + +%% Every qualifier is decorated with a counter. +munge_qualifiers(Qualifiers, Vars) -> + munge_qs(Qualifiers, Vars, []). + +munge_qs([{generate,Line,Pattern,Expr}|Qs], Vars, MQs) -> + L = element(2, Expr), + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + munge_qs1(Qs, L, {generate,Line,Pattern,MungedExpr}, Vars, Vars2, MQs); +munge_qs([{b_generate,Line,Pattern,Expr}|Qs], Vars, MQs) -> + L = element(2, Expr), + {MExpr, Vars2} = munge_expr(Expr, Vars), + munge_qs1(Qs, L, {b_generate,Line,Pattern,MExpr}, Vars, Vars2, MQs); +munge_qs([Expr|Qs], Vars, MQs) -> + L = element(2, Expr), + {MungedExpr, Vars2} = munge_expr(Expr, Vars), + munge_qs1(Qs, L, MungedExpr, Vars, Vars2, MQs); +munge_qs([], Vars, MQs) -> + {reverse(MQs), Vars}. + +munge_qs1(Qs, Line, NQ, Vars, Vars2, MQs) -> + case new_bumps(Vars2, Vars) of + [_] -> + munge_qs(Qs, Vars2, [NQ | MQs]); + _ -> + {MungedTrue, Vars3} = munge_expr(?BLOCK({atom,Line,true}), Vars2), + munge_qs(Qs, Vars3, [NQ, MungedTrue | MQs]) + end. + +new_bumps(#vars{lines = New}, #vars{lines = Old}) -> + subtract(New, Old). + +subtract(L1, L2) -> + [E || E <- L1, not lists:member(E, L2)]. + +common_elems(L1, L2) -> + [E || E <- L1, lists:member(E, L2)]. + +%%%--Analysis------------------------------------------------------------ + +%% Collect data for all modules +collect(Nodes) -> + %% local node + MS = ets:fun2ms(fun({M,C}) when is_atom(M) -> {M,C} end), + AllClauses = ets:select(?COVER_TABLE,MS), + move_modules(AllClauses), + + %% remote nodes + remote_collect('_',Nodes,false). + +%% Collect data for one module +collect(Module,Clauses,Nodes) -> + %% local node + move_modules([{Module,Clauses}]), + + %% remote nodes + remote_collect(Module,Nodes,false). + + +%% When analysing, the data from the local ?COVER_TABLE is moved to the +%% ?COLLECTION_TABLE. Resetting data in ?COVER_TABLE +move_modules([{Module,Clauses}|AllClauses]) -> + ets:insert(?COLLECTION_TABLE,{Module,Clauses}), + move_clauses(Clauses), + move_modules(AllClauses); +move_modules([]) -> + ok. + +move_clauses([{M,F,A,C,_L}|Clauses]) -> + Pattern = {#bump{module=M, function=F, arity=A, clause=C}, '_'}, + Bumps = ets:match_object(?COVER_TABLE,Pattern), + lists:foreach(fun({Key,Val}) -> + ets:insert(?COVER_TABLE, {Key,0}), + insert_in_collection_table(Key,Val) + end, + Bumps), + move_clauses(Clauses); +move_clauses([]) -> + ok. + + +%% Given a .beam file, find the .erl file. Look first in same directory as +%% the .beam file, then in /../src +find_source(File0) -> + case filename:rootname(File0,".beam") of + File0 -> + File0; + File -> + InSameDir = File++".erl", + case filelib:is_file(InSameDir) of + true -> + InSameDir; + false -> + Dir = filename:dirname(File), + Mod = filename:basename(File), + InDotDotSrc = filename:join([Dir,"..","src",Mod++".erl"]), + case filelib:is_file(InDotDotSrc) of + true -> + InDotDotSrc; + false -> + {beam,File0} + end + end + end. + +%% do_analyse(Module, Analysis, Level, Clauses)-> {ok,Answer} | {error,Error} +%% Clauses = [{Module,Function,Arity,Clause,Lines}] +do_analyse(Module, Analysis, line, _Clauses) -> + Pattern = {#bump{module=Module},'_'}, + Bumps = ets:match_object(?COLLECTION_TABLE, Pattern), + Fun = case Analysis of + coverage -> + fun({#bump{line=L}, 0}) -> + {{Module,L}, {0,1}}; + ({#bump{line=L}, _N}) -> + {{Module,L}, {1,0}} + end; + calls -> + fun({#bump{line=L}, N}) -> + {{Module,L}, N} + end + end, + Answer = lists:keysort(1, lists:map(Fun, Bumps)), + {ok, Answer}; +do_analyse(_Module, Analysis, clause, Clauses) -> + Fun = case Analysis of + coverage -> + fun({M,F,A,C,Ls}) -> + Pattern = {#bump{module=M,function=F,arity=A, + clause=C},0}, + Bumps = ets:match_object(?COLLECTION_TABLE, Pattern), + NotCov = length(Bumps), + {{M,F,A,C}, {Ls-NotCov, NotCov}} + end; + calls -> + fun({M,F,A,C,_Ls}) -> + Pattern = {#bump{module=M,function=F,arity=A, + clause=C},'_'}, + Bumps = ets:match_object(?COLLECTION_TABLE, Pattern), + {_Bump, Calls} = hd(lists:keysort(1, Bumps)), + {{M,F,A,C}, Calls} + end + end, + Answer = lists:map(Fun, Clauses), + {ok, Answer}; +do_analyse(Module, Analysis, function, Clauses) -> + {ok, ClauseResult} = do_analyse(Module, Analysis, clause, Clauses), + Result = merge_clauses(ClauseResult, merge_fun(Analysis)), + {ok, Result}; +do_analyse(Module, Analysis, module, Clauses) -> + {ok, FunctionResult} = do_analyse(Module, Analysis, function, Clauses), + Result = merge_functions(FunctionResult, merge_fun(Analysis)), + {ok, {Module,Result}}. + +merge_fun(coverage) -> + fun({Cov1,NotCov1}, {Cov2,NotCov2}) -> + {Cov1+Cov2, NotCov1+NotCov2} + end; +merge_fun(calls) -> + fun(Calls1, Calls2) -> + Calls1+Calls2 + end. + +merge_clauses(Clauses, MFun) -> merge_clauses(Clauses, MFun, []). +merge_clauses([{{M,F,A,_C1},R1},{{M,F,A,C2},R2}|Clauses], MFun, Result) -> + merge_clauses([{{M,F,A,C2},MFun(R1,R2)}|Clauses], MFun, Result); +merge_clauses([{{M,F,A,_C},R}|Clauses], MFun, Result) -> + merge_clauses(Clauses, MFun, [{{M,F,A},R}|Result]); +merge_clauses([], _Fun, Result) -> + reverse(Result). + +merge_functions([{_MFA,R}|Functions], MFun) -> + merge_functions(Functions, MFun, R); +merge_functions([],_MFun) -> % There are no clauses. + {0,0}. % No function can be covered or notcov. + +merge_functions([{_MFA,R}|Functions], MFun, Result) -> + merge_functions(Functions, MFun, MFun(Result, R)); +merge_functions([], _MFun, Result) -> + Result. + +%% do_analyse_to_file(Module,OutFile,ErlFile) -> {ok,OutFile} | {error,Error} +%% Module = atom() +%% OutFile = ErlFile = string() +do_analyse_to_file(Module, OutFile, ErlFile, HTML) -> + case file:open(ErlFile, [read]) of + {ok, InFd} -> + case file:open(OutFile, [write]) of + {ok, OutFd} -> + if HTML -> + io:format(OutFd, + "\n" + "~s" + "\n" + "
\n",
+				      [OutFile]);
+		       true -> ok
+		    end,
+		    
+		    %% Write some initial information to the output file
+		    {{Y,Mo,D},{H,Mi,S}} = calendar:local_time(),
+		    io:format(OutFd, "File generated from ~s by COVER "
+			             "~p-~s-~s at ~s:~s:~s~n",
+			      [ErlFile,
+			       Y,
+			       string:right(integer_to_list(Mo), 2, $0),
+			       string:right(integer_to_list(D),  2, $0),
+			       string:right(integer_to_list(H),  2, $0),
+			       string:right(integer_to_list(Mi), 2, $0),
+			       string:right(integer_to_list(S),  2, $0)]),
+		    io:format(OutFd, "~n"
+			             "**************************************"
+			             "**************************************"
+			             "~n~n", []),
+
+		    print_lines(Module, InFd, OutFd, 1, HTML),
+		    
+		    if HTML -> io:format(OutFd,"
\n\n\n",[]); + true -> ok + end, + + file:close(OutFd), + file:close(InFd), + + {ok, OutFile}; + + {error, Reason} -> + {error, {file, OutFile, Reason}} + end; + + {error, Reason} -> + {error, {file, ErlFile, Reason}} + end. + +print_lines(Module, InFd, OutFd, L, HTML) -> + case io:get_line(InFd, '') of + eof -> + ignore; + "%"++_=Line -> %Comment line - not executed. + io:put_chars(OutFd, [tab(),escape_lt_and_gt(Line, HTML)]), + print_lines(Module, InFd, OutFd, L+1, HTML); + RawLine -> + Line = escape_lt_and_gt(RawLine,HTML), + Pattern = {#bump{module=Module,line=L},'$1'}, + case ets:match(?COLLECTION_TABLE, Pattern) of + [] -> + io:put_chars(OutFd, [tab(),Line]); + Ns -> + N = lists:foldl(fun([Ni], Nacc) -> Nacc+Ni end, 0, Ns), + if + N=:=0, HTML=:=true -> + LineNoNL = Line -- "\n", + Str = " 0", + %%Str = string:right("0", 6, 32), + RedLine = ["",Str,fill1(), + LineNoNL,"\n"], + io:put_chars(OutFd, RedLine); + N<1000000 -> + Str = string:right(integer_to_list(N), 6, 32), + io:put_chars(OutFd, [Str,fill1(),Line]); + N<10000000 -> + Str = integer_to_list(N), + io:put_chars(OutFd, [Str,fill2(),Line]); + true -> + Str = integer_to_list(N), + io:put_chars(OutFd, [Str,fill3(),Line]) + end + end, + print_lines(Module, InFd, OutFd, L+1, HTML) + end. + +tab() -> " | ". +fill1() -> "..| ". +fill2() -> ".| ". +fill3() -> "| ". + +%%%--Export-------------------------------------------------------------- +do_export_table(Compiled, Imported, Fd) -> + ModList = merge(Imported,Compiled), + write_module_data(ModList,Fd). + +merge([{Module,File,_ImportFiles}|Imported],ModuleList) -> + case lists:keymember(Module,1,ModuleList) of + true -> + merge(Imported,ModuleList); + false -> + merge(Imported,[{Module,File}|ModuleList]) + end; +merge([],ModuleList) -> + ModuleList. + +write_module_data([{Module,File}|ModList],Fd) -> + write({file,Module,File},Fd), + [Clauses] = ets:lookup(?COLLECTION_TABLE,Module), + write(Clauses,Fd), + ModuleData = ets:match_object(?COLLECTION_TABLE,{#bump{module=Module},'_'}), + do_write_module_data(ModuleData,Fd), + write_module_data(ModList,Fd); +write_module_data([],_Fd) -> + ok. + +do_write_module_data([H|T],Fd) -> + write(H,Fd), + do_write_module_data(T,Fd); +do_write_module_data([],_Fd) -> + ok. + +write(Element,Fd) -> + Bin = term_to_binary(Element,[compressed]), + case byte_size(Bin) of + Size when Size > 255 -> + SizeBin = term_to_binary({'$size',Size}), + file:write(Fd, + <<(byte_size(SizeBin)):8,SizeBin/binary,Bin/binary>>); + Size -> + file:write(Fd,<>) + end, + ok. + +%%%--Import-------------------------------------------------------------- +do_import_to_table(Fd,ImportFile,Imported) -> + do_import_to_table(Fd,ImportFile,Imported,[]). +do_import_to_table(Fd,ImportFile,Imported,DontImport) -> + case get_term(Fd) of + {file,Module,File} -> + case add_imported(Module, File, ImportFile, Imported) of + {ok,NewImported} -> + do_import_to_table(Fd,ImportFile,NewImported,DontImport); + dont_import -> + do_import_to_table(Fd,ImportFile,Imported, + [Module|DontImport]) + end; + {Key=#bump{module=Module},Val} -> + case lists:member(Module,DontImport) of + false -> + insert_in_collection_table(Key,Val); + true -> + ok + end, + do_import_to_table(Fd,ImportFile,Imported,DontImport); + {Module,Clauses} -> + case lists:member(Module,DontImport) of + false -> + ets:insert(?COLLECTION_TABLE,{Module,Clauses}); + true -> + ok + end, + do_import_to_table(Fd,ImportFile,Imported,DontImport); + eof -> + Imported + end. + + +get_term(Fd) -> + case file:read(Fd,1) of + {ok,<>} -> + {ok,Bin1} = file:read(Fd,Size1), + case binary_to_term(Bin1) of + {'$size',Size2} -> + {ok,Bin2} = file:read(Fd,Size2), + binary_to_term(Bin2); + Term -> + Term + end; + eof -> + eof + end. + +%%%--Reset--------------------------------------------------------------- + +%% Reset main node and all remote nodes +do_reset_main_node(Module,Nodes) -> + do_reset(Module), + do_reset_collection_table(Module), + remote_reset(Module,Nodes). + +do_reset_collection_table(Module) -> + ets:delete(?COLLECTION_TABLE,Module), + ets:match_delete(?COLLECTION_TABLE, {#bump{module=Module},'_'}). + +%% do_reset(Module) -> ok +%% The reset is done on a per-clause basis to avoid building +%% long lists in the case of very large modules +do_reset(Module) -> + [{Module,Clauses}] = ets:lookup(?COVER_TABLE, Module), + do_reset2(Clauses). + +do_reset2([{M,F,A,C,_L}|Clauses]) -> + Pattern = {#bump{module=M, function=F, arity=A, clause=C}, '_'}, + Bumps = ets:match_object(?COVER_TABLE, Pattern), + lists:foreach(fun({Bump,_N}) -> + ets:insert(?COVER_TABLE, {Bump,0}) + end, + Bumps), + do_reset2(Clauses); +do_reset2([]) -> + ok. + +do_clear(Module) -> + ets:match_delete(?COVER_TABLE, {Module,'_'}), + ets:match_delete(?COVER_TABLE, {#bump{module=Module},'_'}), + ets:match_delete(?COLLECTION_TABLE, {#bump{module=Module},'_'}). + + + +%%%--Div----------------------------------------------------------------- + +reverse(List) -> + reverse(List,[]). +reverse([H|T],Acc) -> + reverse(T,[H|Acc]); +reverse([],Acc) -> + Acc. + + +escape_lt_and_gt(Rawline,HTML) when HTML =/= true -> + Rawline; +escape_lt_and_gt(Rawline,_HTML) -> + escape_lt_and_gt1(Rawline,[]). + +escape_lt_and_gt1([$<|T],Acc) -> + escape_lt_and_gt1(T,[$;,$t,$l,$&|Acc]); +escape_lt_and_gt1([$>|T],Acc) -> + escape_lt_and_gt1(T,[$;,$t,$g,$&|Acc]); +escape_lt_and_gt1([],Acc) -> + lists:reverse(Acc); +escape_lt_and_gt1([H|T],Acc) -> + escape_lt_and_gt1(T,[H|Acc]). diff --git a/lib/tools/src/cover_web.erl b/lib/tools/src/cover_web.erl new file mode 100644 index 0000000000..69f2f3b1aa --- /dev/null +++ b/lib/tools/src/cover_web.erl @@ -0,0 +1,1184 @@ +%% +%% %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(cover_web). +-author('marting@erix.ericsson.se'). +-behaviour(gen_server). + +%%Export of configuration function +-export([configData/0]). +%% External exports +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-export([start_link/0,start/0,stop/0]). +-export([menu_frame/2,nodes_frame/2,import_frame/2, + compile_frame/2,result_frame/2]). +-export([list_dir/2,compile/2,add_node/2,remove_node/2,result/2, + calls/2,coverage/2,import/2]). + +-record(state,{dir}). + +-include_lib("kernel/include/file.hrl"). + +%% Timeouts +-define(DEFAULT_TIME,10000). +-define(MAX_COMPILE_TIME,60000). +-define(MAX_ANALYSE_TIME,30000). + +%% Colors +-define(INFO_BG_COLOR,"#C0C0EA"). + +%%%---------------------------------------------------------------------- +%%% API - called from erlang shell +%%%---------------------------------------------------------------------- +%% Start webtool and webcover from erlang shell +start() -> + webtool:start(), + webtool:start_tools([],"app=webcover"), + ok. + +%% Stop webtool and webcover from erlang shell +stop() -> + webtool:stop_tools([],"app=webcover"), + webtool:stop(). + + + +%%%---------------------------------------------------------------------- +%%% API - called from webtool +%%%---------------------------------------------------------------------- +start_link() -> + gen_server:start_link({local, webcover_server},cover_web, [], []). + + +nodes_frame(Env,Input)-> + call({nodes_frame,Env,Input}). + +add_node(Env,Input)-> + call({add_node,Env,Input}). + +remove_node(Env,Input)-> + call({remove_node,Env,Input}). + +compile_frame(Env,Input)-> + call({compile_frame,Env,Input}). + +list_dir(Env,Input) -> + call({list_dir,Env,Input}). + +compile(Env,Input)-> + call({compile,Env,Input},?MAX_COMPILE_TIME). + +result_frame(Env,Input)-> + call({result_frame,Env,Input}). + +result(Env,Input) -> + call({result,Env,Input},?MAX_ANALYSE_TIME). + +calls(Env,Input) -> + call({calls,Env,Input}). + +coverage(Env,Input) -> + call({coverage,Env,Input}). + +import_frame(Env,Input)-> + call({import_frame,Env,Input}). + +import(Env,Input)-> + call({import,Env,Input}). + +menu_frame(Env,Input)-> + call({menu_frame,Env,Input}). + +call(Msg) -> + call(Msg,?DEFAULT_TIME). +call(Msg,Time) -> + gen_server:call(webcover_server,Msg,Time). + + + +configData()-> + {webcover,[{web_data,{"WebCover","/webcover"}}, + {alias,{"/webcover",code:priv_dir(tools)}}, + {alias,{erl_alias,"/webcover/erl",[cover_web]}}, + {start,{child,{{local,webcover_server}, + {cover_web,start_link,[]}, + permanent,100,worker,[cover_web]}}} + ]}. + + +%%%---------------------------------------------------------------------- +%%% Callback functions from gen_server +%%%---------------------------------------------------------------------- + +%%---------------------------------------------------------------------- +%% Func: init/1 +%% Returns: {ok, State} | +%% {ok, State, Timeout} | +%% ignore | +%% {stop, Reason} +%%---------------------------------------------------------------------- +init([]) -> + cover:start(), + CS = whereis(cover_server), + link(CS), + GL = spawn_link(fun group_leader_proc/0), + group_leader(GL,CS), + + %% Must trap exists in order to have terminate/2 executed when + %% crashing because of a linked process crash. + process_flag(trap_exit,true), + {ok,Cwd} = file:get_cwd(), + {ok, #state{dir=Cwd}}. + +group_leader_proc() -> + register(cover_group_leader_proc,self()), + group_leader_loop([]). +group_leader_loop(Warnings) -> + receive + {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} -> + Msg = (catch io_lib:Func(Format,Args)), + From ! {io_reply,ReplyAs,ok}, + case lists:member(Msg,Warnings) of + true -> group_leader_loop(Warnings); + false -> group_leader_loop([Msg|Warnings]) + end; + {io_request,From,ReplyAs,{put_chars,_Encoding,io_lib,Func,[Format,Args]}} -> + Msg = (catch io_lib:Func(Format,Args)), + From ! {io_reply,ReplyAs,ok}, + case lists:member(Msg,Warnings) of + true -> group_leader_loop(Warnings); + false -> group_leader_loop([Msg|Warnings]) + end; + IoReq when element(1,IoReq)=:= io_request -> + group_leader() ! IoReq, + group_leader_loop(Warnings); + {From,get_warnings} -> + Warnings1 = + receive + {io_request,From,ReplyAs, + {put_chars,io_lib,Func,[Format,Args]}} -> + Msg = (catch io_lib:Func(Format,Args)), + From ! {io_reply,ReplyAs,ok}, + case lists:member(Msg,Warnings) of + true -> Warnings; + false -> [Msg|Warnings] + end + after 0 -> + Warnings + end, + From ! {warnings,Warnings1}, + group_leader_loop([]) + end. + +%%---------------------------------------------------------------------- +%% Func: handle_call/3 +%% Returns: {reply, Reply, State} | +%% {reply, Reply, State, Timeout} | +%% {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, Reply, State} | (terminate/2 is called) +%% {stop, Reason, State} (terminate/2 is called) +%%---------------------------------------------------------------------- +handle_call({nodes_frame,_Env,_Input},_From,State)-> + {reply,nodes_frame1(),State}; + +handle_call({add_node,_Env,Input},_From,State)-> + {reply,do_add_node(Input),State}; + +handle_call({remove_node,_Env,Input},_From,State)-> + {reply,do_remove_node(Input),State}; + +handle_call({compile_frame,_Env,_Input},_From,State)-> + {reply,compile_frame1(State#state.dir),State}; + +handle_call({list_dir,_Env,Input},_From,State)-> + Dir = get_input_data(Input,"path"), + case filelib:is_dir(Dir) of + true -> + {reply,compile_frame1(Dir),State#state{dir=Dir}}; + false -> + Err = Dir ++ " is not a directory", + {reply,compile_frame1(State#state.dir,Err),State} + end; +handle_call({compile,_Env,Input},_From,State)-> + {reply,do_compile(Input,State#state.dir),State}; + +handle_call({result_frame,_Env,_Input},_From,State)-> + {reply,result_frame1(),State}; + +handle_call({result,_Env,Input},_From,State)-> + {reply,handle_result(Input),State}; + +handle_call({calls,_Env,Input},_From,State)-> + {reply,call_page(Input),State}; + +handle_call({coverage,_Env,Input},_From,State)-> + {reply,coverage_page(Input),State}; + +handle_call({import_frame,_Env,_Input},_From,State)-> + {ok,Cwd} = file:get_cwd(), + {reply,import_frame1(Cwd),State}; + +handle_call({import,_Env,Input},_From,State)-> + {reply,do_import(Input),State}; + +handle_call({menu_frame,_Env,_Input},_From,State)-> + {reply,menu_frame1(),State}; + +handle_call(_Request, _From, State) -> + Reply = bad_request, + {reply, Reply, State}. + + +%%---------------------------------------------------------------------- +%% Func: handle_cast/2 +%% Returns: {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%%---------------------------------------------------------------------- +handle_cast(_Msg, State) -> + {noreply, State}. + +%%---------------------------------------------------------------------- +%% Func: handle_info/2 +%% Returns: {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%%---------------------------------------------------------------------- +handle_info({'EXIT',_Pid,Reason}, State) -> + {stop, Reason, State}. + +%%---------------------------------------------------------------------- +%% Func: terminate/2 +%% Purpose: Shutdown the server +%% Returns: any (ignored by gen_server) +%%---------------------------------------------------------------------- +terminate(_Reason, _State) -> + cover:stop(), + ok. + +%%-------------------------------------------------------------------- +%% Func: code_change/3 +%% Purpose: Convert process state when code is changed +%% Returns: {ok, NewState} +%%-------------------------------------------------------------------- +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%---------------------------------------------------------------------- +%%% Internal functions +%%%---------------------------------------------------------------------- + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% The functions that creates the whole pages by collecting all the %% +%% neccessary data for each page. These functions are the public %% +%% interface. %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%---------------------------------------------------------------------- +%% Returns the page to the left frame +%%---------------------------------------------------------------------- +menu_frame1()-> + [header(),html_header(""),menu_body(),html_end()]. + +%%---------------------------------------------------------------------- +%% Creates the page where the user can add and remove nodes +%%---------------------------------------------------------------------- + +nodes_frame1()-> + nodes_frame1([]). +nodes_frame1(Err)-> + [header(),html_header("Add/remove nodes"),nodes_body(Err),html_end()]. + +%%---------------------------------------------------------------------- +%% Creates the page where the user can cover compile modules +%%---------------------------------------------------------------------- + +compile_frame1(Dir)-> + compile_frame1(Dir,[]). +compile_frame1(Dir,Err) -> + [header(),html_header("Cover compile"),compile_body(Dir,Err),html_end()]. + +%%---------------------------------------------------------------------- +%% Creates the page where the user can handle results +%%---------------------------------------------------------------------- + +result_frame1()-> + result_frame1([]). +result_frame1(Err) -> + [header(),html_header("Show cover results"),result_body(Err),html_end()]. + +%%---------------------------------------------------------------------- +%%The beginning of the page that clear the cover information on a cover +%%compiled module +%%---------------------------------------------------------------------- +call_page(Input)-> + [header(),html_header("Code coverage"),call_result(Input),html_end()]. + +coverage_page(Input)-> + [header(),html_header("Code coverage"),coverage_result(Input),html_end()]. + +%%---------------------------------------------------------------------- +%% Creates the page where the user an import files +%%---------------------------------------------------------------------- +import_frame1(Dir) -> + import_frame1(Dir,""). +import_frame1(Dir,Err) -> + [header(),html_header("Import coverdata"),import_body(Dir,Err),html_end()]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% The functions that build the body of the menu frame %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +menu_body() -> + Nodes = cover:which_nodes(), + Modules = cover:modules(), + Imported = cover:imported(), + ["Nodes
\n", + "Compile
\n", + "Import
\n", + "Result\n", + "

Nodes:\n", + "

    \n", + lists:map(fun(N) -> "
  • "++atom_to_list(N)++"
    • \n" end,[node()|Nodes]), + "
\n", + "

Compiled modules:\n", + "

    \n", + lists:map(fun(M) -> "
  • "++atom_to_list(M)++"
    • \n" end,Modules), + "
\n", + "

Imported files:\n", + "

    \n", + "\n", + lists:map(fun(F) -> + Short = filename:basename(F), + "
  • "++Short++"
    • \n" end,Imported), + "    \n", + "
\n"]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% The functions that build the body of the nodes frame %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +nodes_body(Err) -> + CN = cover:which_nodes(), + Fun = fun(N) -> + NStr = atom_to_list(N), + ["\n"] + end, + AllNodes = lists:append(lists:map(Fun,nodes()--CN)), + CoverNodes = lists:append(lists:map(Fun,CN)), + + [reload_menu_script(Err), + "

Nodes

\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n" + "\n", + "\n", + "\n", + "\n", + "\n", + "", + "
\n", + "

You can run cover over several nodes simultaneously. Coverage data\n", + "from all involved nodes will be merged during analysis.\n", + "

Select or enter node names to add or remove here.\n", + "



Add node:", + "" + "
\n", + "


Remove node:\n", + "" + "
"]. + + +do_add_node(Input) -> + NodeStr = get_input_data(Input, "node"), + Node = list_to_atom(NodeStr), + case net_adm:ping(Node) of + pong -> + cover:start(Node), + nodes_frame1(); + pang -> + nodes_frame1("Node \\\'" ++ NodeStr ++ "\\\' is not alive") + end. + +do_remove_node(Input) -> + Node = list_to_atom(get_input_data(Input, "node")), + cover:stop(Node), + nodes_frame1(). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% % +% The functions that is used when the user wants to compile something % +% % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +compile_body(Dir,Err) -> + Erls = filelib:wildcard(filename:join(Dir,"*.erl")), + Beams = filelib:wildcard(filename:join(Dir,"*.beam")), + + [reload_menu_script(Err), + "

Compile

\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n" + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "
\n", + "Each module which shall be part of the cover analysis must be prepared\n", + "or 'cover compiled'. On this page you can select .erl files and/or\n", + ".beam files to include in the analysis. If you select a .erl file it\n", + "will first be compiled with the Erlang compiler and then prepared for\n", + "coverage analysis. If you select a .beam file it will be prepared for\n", + "coverage analysis directly.\n", + "
\n", + "To list a different directory, enter the directory name here.\n", + "
List directory:
\n", + "", + "", + "

\n", + "

Select one or more .erl or .beam files to prepare for coverage\n" + "analysis, and click the \"Compile\" button.\n", + "

To reload the original file after coverage analysis is complete,\n" + "select one or more files and click the \"Uncompile\" button, or\n", + "simply click the \"Uncompile all\" button to reload all originals.\n" + "

.erl files.beam files
\n", + "\n", + "
\n", + "Compile options are only needed for .erl files. The options must be\n" + "given e.g. like this: \n" + "[{i,\"/my/path/include\"},{i,\"/other/path/\"}]\n" + "
Compile options:
\n", + "\n", + "
\n", + "", + "", + "", + "
\n"]. + +list_modules([File|Files]) -> + Mod = filename:basename(File), + ["\n" | list_modules(Files)]; +list_modules([]) -> + []. + +do_compile(Input,Dir) -> + {Erls,Beams,Opts,Action} = get_compile_input(parse(Input),[],[]), + Errs = + case Action of + "compile" -> + do_compile(Erls,Beams,Opts,[]); + "uncompile" -> + do_uncompile(Erls++Beams); + "uncompile_all" -> + do_uncompile(cover:modules()) + end, + compile_frame1(Dir,Errs). + +get_compile_input([{"erl",File}|Input],Erl,Beam) -> + get_compile_input(Input,[File|Erl],Beam); +get_compile_input([{"beam",File}|Input],Erl,Beam) -> + get_compile_input(Input,Erl,[File|Beam]); +get_compile_input([{"options",Opts0},{"action",Action}],Erl,Beam) -> + Opts = parse_options(Opts0), + {Erl,Beam,Opts,Action}. + +do_compile([Erl|Erls],Beams,Opts,Errs) -> + case cover:compile_module(Erl,Opts) of + {ok,_} -> + do_compile(Erls,Beams,Opts,Errs); + {error,File} -> + do_compile(Erls,Beams,Opts,["\\n"++File|Errs]) + end; +do_compile([],[Beam|Beams],Opts,Errs) -> + case cover:compile_beam(Beam) of + {ok,_} -> + do_compile([],Beams,Opts,Errs); + {error,{no_abstract_code,File}} -> + do_compile([],Beams,Opts,["\\n"++File++" (no_abstract_code)"|Errs]) + end; +do_compile([],[],_,[]) -> + []; +do_compile([],[],_,Errs) -> + "Compilation failed for the following files:" ++ Errs. + +parse_options(Options)-> + case erl_scan:string(Options ++".") of + {ok,Tokens,_Line} -> + case erl_parse:parse_exprs(Tokens) of + {ok,X}-> + case lists:map(fun erl_parse:normalise/1, X) of + [List] when is_list(List) -> List; + List -> List + end; + _ -> + [] + end; + _ -> + [] + end. + + +do_uncompile(Files) -> + lists:foreach( + fun(File) -> + Module = + if is_atom(File) -> + File; + true -> + ModStr = filename:basename(filename:rootname(File)), + list_to_atom(ModStr) + end, + case code:which(Module) of + cover_compiled -> + code:purge(Module), + case code:load_file(Module) of + {module, Module} -> + ok; + {error, _Reason2} -> + code:delete(Module) + end; + _ -> + ok + end + end, + Files), + []. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% % +% The functions that builds the body of the page for coverage analysis% +% % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +result_body(Err) -> + [reload_menu_script(Err), + "

Result

\n", + "\n", + "\n", + "
\n", + "

After executing all your tests you can view the result of the\n", + "coverage analysis here. For each module you can\n", + "

\n", + "
Analyse to file
\n", + "
The source code of the module is shown with the number of calls\n", + "to each line stated in the left margin. Lines which are never called\n", + "are colored red.
\n", + "
Analyse coverage
\n", + "
Show the number of covered and uncovered lines in the module.
\n", + "
Analyse calls
\n", + "
Show the number of calls in the module.
\n", + "
Reset module
\n", + "
Delete all coverage data for the module.
\n", + "
Export module
\n", + "
Write all coverage data for the module to a file. The data can\n", + "later be imported from the \"Import\" page.
\n", + "
\n", + "

You can also reset or export data for all modules with the\n", + "Reset all and Export all actions respectively. For these\n", + "two actions there is no need to select a module.\n", + "

Select module and action from the drop down menus below, and click\n", + "the \"Execute\" button.\n", + "



\n", + result_selections(), + "
"]. + +result_selections() -> + ModList = filter_modlist(cover:modules()++cover:imported_modules(),[]), + + ["
\n", + "\n", + "\n", + "\n", + "\n" + "
\n", + "Module:\n", + "
\n", + "		\n", + "Action:\n", + "
\n", + "		\n" + "
\n", + "
\n"]. + +filter_modlist([M|Ms],Already) -> + case lists:member(M,Already) of + true -> + filter_modlist(Ms,Already); + false -> + MStr = atom_to_list(M), + ["\n" | + filter_modlist(Ms,[M|Already])] + end; +filter_modlist([],_Already) -> + []. + + + +handle_result(Input) -> + case parse(Input) of + [{"module",M},{"action",A}] -> + case A of + "analyse_to_file" -> + case cover:analyse_to_file(list_to_atom(M),[html]) of + {ok,File} -> + case file:read_file(File) of + {ok,HTML}-> + file:delete(File), + [header(), + reload_menu_script(""), + binary_to_list(HTML)]; + _ -> + result_frame1("Can not read file" ++ File) + end; + {error,no_source_code_found} -> + result_frame1("No source code found for \\\'" ++ + M ++ "\\\'") + end; + "calls" -> + call_page(Input); + "coverage" -> + coverage_page(Input); + "reset" -> + cover:reset(list_to_atom(M)), + result_frame1("Coverage data for \\\'" ++ M ++ + "\\\' is now reset"); + "reset_all" -> + cover:reset(), + result_frame1("All coverage data is now reset"); + "export" -> + ExportFile = generate_filename(M), + cover:export(ExportFile,list_to_atom(M)), + result_frame1("Coverage data for \\\'" ++ M ++ + "\\\' is now exported to file \\\"" ++ + ExportFile ++ "\\\""); + "export_all" -> + ExportFile = generate_filename("COVER"), + cover:export(ExportFile), + result_frame1( + "All coverage data is now exported to file \\\"" ++ + ExportFile ++ "\\\"") + end; + [{"action",_A}] -> + result_frame1("No module is selected") + end. + +generate_filename(Prefix) -> + {ok,Cwd} = file:get_cwd(), + filename:join(Cwd,Prefix ++ "_" ++ ts() ++ ".coverdata"). + +ts() -> + {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(now()), + io_lib:format("~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w", + [Y,M,D,H,Min,S]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% % +% The functions that builds the body of the page that shows the calls % +% % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +call_result(Input)-> + Mod = list_to_atom(get_input_data(Input, "module")), + case cover:analyse(Mod,calls) of + {error,_}-> + error_body(); + {ok,_} -> + call_result2(Mod,Input) + end. + +call_result2(Mod,Input)-> + Result = + case get_input_data(Input,"what") of + "mod" -> + call_result(mod,Mod); + "func" -> + call_result(func,Mod); + "clause" -> + call_result(clause,Mod); + _-> + call_result(all,Mod) + end, + result_choice("calls",Mod) ++ Result. + +result_choice(Level,Mod)-> + ModStr=atom_to_list(Mod), + [reload_menu_script(""), + "\n", + "\n", + "\n", + "\n", + "\n", + "
All DataModuleFunctionClause

\n"]. + +call_result(Mode,Module)-> + Content = + case Mode of + mod-> + format_cover_call(cover:analyse(Module,calls,module),mod); + func-> + format_cover_call(cover:analyse(Module,calls,function),func); + clause-> + format_cover_call(cover:analyse(Module,calls,clause),clause); + _-> + format_cover_call(cover:analyse(Module,calls,module),mod) ++ + format_cover_call(cover:analyse(Module,calls,function),func)++ + format_cover_call(cover:analyse(Module,calls,clause),clause) + end, + getModDate(Module,date())++"
"++ + "" + ++ Content ++"
". + + +format_cover_call({error,_},_)-> + ["\n", + "



\n", + "The selected module is not Cover Compiled\n", + "
\n", + "\n"]; + +format_cover_call({ok,{Mod,Calls}},mod)-> + ["Module calls\n", + "Module", + "Number of calls\n", + "" ++ atom_to_list(Mod) ++"" + "" ++ integer_to_list(Calls)++"\n"]; + +format_cover_call({ok,Calls},func)-> + ["Function calls\n", + "ModuleFunction", + "Arity", + "Number of calls \n", + lists:append( + lists:map( + fun({{Mod,Func,Arity},Nr_of_calls})-> + [""++ atom_to_list(Mod)++"\n", + "" ++ atom_to_list(Func) ++" \n", + "", + integer_to_list(Arity), + "\n", + "", + integer_to_list(Nr_of_calls), + "\n"] + end, + Calls))]; + +format_cover_call({ok,Calls},clause)-> + ["Clause calls\n", + "ModuleFunction", + "Arity", + "Ordinal", + "Number of calls\n", + lists:append( + lists:map( + fun({{Mod,Func,Arity,Ord},Nr_of_calls})-> + ["", atom_to_list(Mod), "\n", + "", atom_to_list(Func), "\n", + "", + integer_to_list(Arity), + "\n", + "", + integer_to_list(Ord), + "\n", + "", + integer_to_list(Nr_of_calls), + "\n"] + end, + Calls))]. + + +error_body()-> + ["\n", + "\n", + "\n", + "\n", + "
\n", + "





\n", + "The selected module is not Cover Compiled\n", + "
\n", + "
\n"]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% % +% The functions that builds the body of the page that shows coverage % +% % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +coverage_result(Input)-> + Mod = list_to_atom(get_input_data(Input, "module")), + case cover:analyse(Mod,coverage) of + {error,_}-> + error_body(); + {ok,_} -> + coverage_result2(Mod,Input) + end. + +coverage_result2(Mod,Input)-> + Result = + case get_input_data(Input,"what") of + "mod" -> + coverage_result(mod,Mod); + "func" -> + coverage_result(func,Mod); + "clause" -> + coverage_result(clause,Mod); + _-> + coverage_result(all,Mod) + end, + result_choice("coverage",Mod) ++ Result. + +coverage_result(Mode,Module)-> + Content = + case Mode of + mod-> + format_cover_coverage(cover:analyse(Module,coverage,module), + mod); + func-> + format_cover_coverage(cover:analyse(Module,coverage,function), + func); + clause-> + format_cover_coverage(cover:analyse(Module,coverage,clause), + clause); + _-> + format_cover_coverage(cover:analyse(Module,coverage,module), + mod) ++ + format_cover_coverage(cover:analyse(Module,coverage,function), + func)++ + format_cover_coverage(cover:analyse(Module,coverage,clause), + clause) + end, + getModDate(Module,date())++"
"++ + "" + ++ Content ++"
". + +getModDate(Module,{Year,Mon,Day})-> + " + + + + + + + + +
Module:" ++ atom_to_list(Module) ++ "
Date:" ++ integer_to_list(Day) ++ "/" ++ + integer_to_list(Mon) ++" - "++ + integer_to_list(Year) ++ + "
". + + +format_cover_coverage({error,_},_)-> + " +



+ The selected module is not Cover Compiled +
+ "; + + +format_cover_coverage({ok,{Mod,{Cov,Not_cov}}},mod)-> + ["Module coverage\n", + "Module\n", + "Covered\n" + "Not Covered\n", + "\n", + "", atom_to_list(Mod), "\n" + "", integer_to_list(Cov), "\n" + "", integer_to_list(Not_cov), "\n"]; + +format_cover_coverage({ok,Cov_res},func)-> + ["Function coverage\n", + "\n", + "ModuleFunction", + "Arity", + "Covered", + "Not Covered", + "\n", + lists:append( + lists:map( + fun({{Mod,Func,Arity},{Cov,Not_cov}})-> + [""++ atom_to_list(Mod) ++" \n", + "" ++ atom_to_list(Func) ++"\n", + "", + integer_to_list(Arity), + "\n", + "", + integer_to_list(Cov), + "\n" + "", + integer_to_list(Not_cov), + "\n"] + end, + Cov_res))]; + +format_cover_coverage({ok,Cov_res},clause)-> + ["Clause coverage\n", + "ModuleFunction\n", + "Arity\n", + "Ordinal\n", + "Covered\n", + "Not Covered\n", + lists:append( + lists:map( + fun({{Mod,Func,Arity,Ord},{Cov,Not_cov}})-> + [""++ atom_to_list(Mod) ++"\n", + "" ++ atom_to_list(Func) ++" \n", + "", + integer_to_list(Arity), + "\n" + "", + integer_to_list(Ord), + "\n" + "", + integer_to_list(Cov), + "\n" + "", + integer_to_list(Not_cov), + "\n"] + end, + Cov_res))]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% % +% The functions that builds the body of the import page % +% % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +import_body(Dir,Err) -> + [reload_menu_script(Err), + "

Import

\n", + "\n", + "\n", + "
\n", + "

You can import coverage data from a previous analysis. If you do so\n", + "the imported data will be merged with the current coverage data.\n", + "

You can export data from the current analysis from the \"Result\"\n", + "page.\n", + "

Select the file to import here.\n", + "



\n", + "
\n", + "Change directory:
\n", + "", + "\n", + "
\n", + "
\n", + browse_import(Dir), + "
"]. + +browse_import(Dir) -> + {ok,List} = file:list_dir(Dir), + Sorted = lists:reverse(lists:sort(List)), + {Dirs,Files} = filter_files(Dir,Sorted,[],[]), + ["
\n" + "\n", + "\n", + "
\n" + "
\n"]. + +filter_files(Dir,[File|Files],Ds,Fs) -> + case filename:extension(File) of + ".coverdata" -> + Fs1 = ["\n" | Fs], + filter_files(Dir,Files,Ds,Fs1); + _ -> + FullName = filename:join(Dir,File), + case filelib:is_dir(FullName) of + true -> + Ds1 = ["\n" | Ds], + filter_files(Dir,Files,Ds1,Fs); + false -> + filter_files(Dir,Files,Ds,Fs) + end + end; +filter_files(_Dir,[],Ds,Fs) -> + {Ds,Fs}. + + + + +do_import(Input) -> + case parse(Input) of + [{"file",File0},{"dir",Dir}] -> + File = filename:join(Dir,File0), + case filelib:is_dir(File) of + true -> + import_frame1(File); + false -> + case filelib:is_file(File) of + true -> + case cover:import(File) of + ok -> + import_frame1(Dir); + {error,{cant_open_file,ExportFile,_Reason}} -> + import_frame1(Dir, + "Error importing file\\n\\\"" + ++ ExportFile ++ "\\\"") + end; + false -> + import_frame1(Dir, + "Error importing file\\n\\\"" ++ + File ++ "\\\"") + end + end; + [{"dir",Dir}] -> + import_frame1(Dir,"No file is selected") + end. + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% % +% Different private helper functions % +% % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%Create the Header for the page If we now the mimetype use that type %% +%%otherwise use text %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +header() -> + header("text/html"). +header(MimeType) -> + "Pragma:no-cache\r\n" ++ + "Content-type: " ++ MimeType ++ "\r\n\r\n". + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%Create the Htmlheader set the title of the page %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +html_header(Title) -> + "\n" ++ + "\n" ++ + "" ++ Title ++ "\n" ++ + "\n" + "\n". + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Close the body- and Html tags %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +html_end()-> + "". + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% A script which reloads the menu frame and possibly pops up an alert%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +reload_menu_script(Err) -> + ["\n", + ""]. + +fix_newline([$\n|Rest]) -> + [$\\,$n|fix_newline(Rest)]; +fix_newline([$"|Rest]) -> + [$\\,$"|fix_newline(Rest)]; +fix_newline([Char|Rest]) -> + [Char|fix_newline(Rest)]; +fix_newline([]) -> + []. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Control the input data and return the intresting values or error % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +get_input_data(Input,Key)-> + case lists:keysearch(Key,1,parse(Input)) of + {value,{Key,Value}} -> + Value; + false -> + undefined + end. + +parse(Input) -> + httpd:parse_query(Input). + + +get_warnings() -> + cover_group_leader_proc ! {self(), get_warnings}, + receive {warnings,Warnings} -> + Warnings + end. diff --git a/lib/tools/src/cprof.erl b/lib/tools/src/cprof.erl new file mode 100644 index 0000000000..b0c3341efa --- /dev/null +++ b/lib/tools/src/cprof.erl @@ -0,0 +1,142 @@ +%% +%% %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(cprof). + +%% Call count profiling tool. + +-export ([start/0, start/1, start/2, start/3, + stop/0, stop/1, stop/2, stop/3, + restart/0, restart/1, restart/2, restart/3, + pause/0, pause/1, pause/2, pause/3, + analyse/0, analyse/1, analyse/2, + analyze/0, analyze/1, analyze/2]). + + + +start() -> + tr({'_','_','_'}, true) + tr(on_load, true). + +start({_,_,_} = MFA) -> + tr(MFA, true); +start({FuncSpec}) -> + tr(FuncSpec, true); +start(M) -> + tr({M,'_','_'}, true). + +start(M,F) -> + tr({M,F,'_'}, true). + +start(M,F,A) -> + tr({M,F,A}, true). + + + +stop() -> + tr({'_','_','_'}, false) + tr(on_load, false). + +stop({_,_,_} = MFA) -> + tr(MFA, false); +stop({FuncSpec}) -> + tr(FuncSpec, false); +stop(M) -> + tr({M,'_','_'}, false). + +stop(M,F) -> + tr({M,F,'_'}, false). + +stop(M,F,A) -> + tr({M,F,A}, false). + + + +restart() -> + tr({'_','_','_'}, restart). + +restart({_,_,_} = MFA) -> + tr(MFA, restart); +restart({FuncSpec}) -> + tr(FuncSpec, restart); +restart(M) -> + tr({M,'_','_'}, restart). + +restart(M,F) -> + tr({M,F,'_'}, restart). + +restart(M,F,A) -> + tr({M,F,A}, restart). + + + +pause() -> + tr({'_','_','_'}, pause) + tr(on_load, false). + +pause({_,_,_} = MFA) -> + tr(MFA, pause); +pause({FuncSpec}) -> + tr(FuncSpec, pause); +pause(M) -> + tr({M,'_','_'}, pause). + +pause(M,F) -> + tr({M,F,'_'}, pause). + +pause(M,F,A) -> + tr({M,F,A}, pause). + + + +analyse() -> + analyse(1). + +analyse(Limit) when is_integer(Limit) -> + L0 = [analyse(element(1, Mod), Limit) || Mod <- code:all_loaded()], + L1 = [{C,M,Lm} || {M,C,Lm} <- L0, C > 0, M =/= ?MODULE], + N = lists:foldl(fun ({C,_,_}, Q) -> Q+C end, 0, L1), + L = [{M,C,Lm} || {C,M,Lm} <- lists:reverse(lists:sort(L1))], + {N,L}; +analyse(M) when is_atom(M) -> + analyse(M, 1). + +analyse(M, Limit) when is_atom(M), is_integer(Limit) -> + L0 = [begin + MFA = {M,F,A}, + {_,C} = erlang:trace_info(MFA, call_count), + [C|MFA] + end || {F,A} <- M:module_info(functions)], + L1 = [X || [C|_]=X <- L0, is_integer(C)], + N = lists:foldl(fun ([C|_], Q) -> Q+C end, 0, L1), + L2 = [X || [C|_]=X <- L1, C >= Limit], + L = [{MFA,C} || [C|MFA] <- lists:reverse(lists:sort(L2))], + {M,N,L}. + + + +analyze() -> + analyse(). + +analyze(X) -> + analyse(X). + +analyze(X, Y) -> + analyse(X, Y). + + + +tr(FuncSpec, State) -> + erlang:trace_pattern(FuncSpec, State, [call_count]). diff --git a/lib/tools/src/eprof.erl b/lib/tools/src/eprof.erl new file mode 100644 index 0000000000..b4313d6888 --- /dev/null +++ b/lib/tools/src/eprof.erl @@ -0,0 +1,478 @@ +%% +%% %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: Profile a system in order to figure out where the +%% time goes. +%% + +-module(eprof). +-behaviour(gen_server). + +-export([start/0, stop/0, dump/0, total_analyse/0, + start_profiling/1, profile/2, profile/4, profile/1, + stop_profiling/0, analyse/0, log/1]). + +%% Internal exports +-export([init/1, + call/4, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +-include_lib("stdlib/include/qlc.hrl"). + +-import(lists, [flatten/1,reverse/1,keysort/2]). + + +-record(state, {table = notable, + proc = noproc, + profiling = false, + pfunc = undefined, + pop = running, + ptime = 0, + overhead = 0, + rootset = []}). + +%%%%%%%%%%%%%% + +start() -> gen_server:start({local, eprof}, eprof, [], []). +stop() -> gen_server:call(eprof, stop, infinity). + + +profile(Pids, Fun) -> + start(), + gen_server:call(eprof, {profile,Pids,erlang,apply,[Fun,[]]},infinity). + +profile(Pids, M, F, A) -> + start(), + gen_server:call(eprof, {profile,Pids,M,F,A},infinity). + +dump() -> + gen_server:call(eprof, dump, infinity). + +analyse() -> + gen_server:call(eprof, analyse, infinity). + +log(File) -> + gen_server:call(eprof, {logfile, File}, infinity). + +total_analyse() -> + gen_server:call(eprof, total_analyse, infinity). + +start_profiling(Rootset) -> + start(), + gen_server:call(eprof, {profile, Rootset}, infinity). + +stop_profiling() -> + gen_server:call(eprof, stop_profiling, infinity). + +profile(Rs) -> + start_profiling(Rs). + +%%%%%%%%%%%%%%%% + +init(_) -> + process_flag(trap_exit, true), + process_flag(priority, max), + put(three_one, {3,1}), %To avoid building garbage. + {ok, #state{}}. + +subtr({X1,Y1,Z1}, {X1,Y1,Z2}) -> + Z1 - Z2; +subtr({X1,Y1,Z1}, {X2,Y2,Z2}) -> + (((X1-X2) * 1000000) + Y1 - Y2) * 1000000 + Z1 - Z2. + +update_call_statistics(Tab, Key, Time) -> + try ets:update_counter(Tab, Key, Time) of + NewTime when is_integer(NewTime) -> + ets:update_counter(Tab, Key, get(three_one)) + catch + error:badarg -> + ets:insert(Tab, {Key,Time,1}) + end. + +update_other_statistics(Tab, Key, Time) -> + try + ets:update_counter(Tab, Key, Time) + catch + error:badarg -> + ets:insert(Tab, {Key,Time,0}) + end. + +do_messages({trace_ts,From,Op,Mfa,Time}, Tab, undefined,_PrevOp0,_PrevTime0) -> + PrevFunc = [From|Mfa], + receive + {trace_ts,_,_,_,_}=Ts -> do_messages(Ts, Tab, PrevFunc, Op, Time) + after 0 -> + {PrevFunc,Op,Time} + end; +do_messages({trace_ts,From,Op,Mfa,Time}, Tab, PrevFunc0, call, PrevTime0) -> + update_call_statistics(Tab, PrevFunc0, subtr(Time, PrevTime0)), + PrevFunc = case Op of + exit -> undefined; + out -> undefined; + _ -> [From|Mfa] + end, + receive + {trace_ts,_,_,_,_}=Ts -> do_messages(Ts, Tab, PrevFunc, Op, Time) + after 0 -> + {PrevFunc,Op,Time} + end; +do_messages({trace_ts,From,Op,Mfa,Time}, Tab, PrevFunc0, _PrevOp0, PrevTime0) -> + update_other_statistics(Tab, PrevFunc0, subtr(Time, PrevTime0)), + PrevFunc = case Op of + exit -> undefined; + out -> undefined; + _ -> [From|Mfa] + end, + receive + {trace_ts,_,_,_,_}=Ts -> do_messages(Ts, Tab, PrevFunc, Op, Time) + after 0 -> + {PrevFunc,Op,Time} + end. + +%%%%%%%%%%%%%%%%%% + +handle_cast(_Req, S) -> {noreply, S}. + +terminate(_Reason,_S) -> + call_trace_for_all(false), + normal. + +%%%%%%%%%%%%%%%%%% + +handle_call({logfile, F}, _FromTag, Status) -> + case file:open(F, [write]) of + {ok, Fd} -> + case get(fd) of + undefined -> ok; + FdOld -> file:close(FdOld) + end, + put(fd, Fd), + {reply, ok, Status}; + {error, _} -> + {reply, error, Status} + end; + +handle_call({profile, Rootset}, {From, _Tag}, S) -> + link(From), + maybe_delete(S#state.table), + io:format("eprof: Starting profiling ..... ~n",[]), + ptrac(S#state.rootset, false, all()), + flush_receive(), + Tab = ets:new(eprof, [set, public]), + case ptrac(Rootset, true, all()) of + false -> + {reply, error, #state{}}; + true -> + uni_schedule(), + call_trace_for_all(true), + erase(replyto), + {reply, profiling, #state{table = Tab, + proc = From, + profiling = true, + rootset = Rootset}} + end; + +handle_call(stop_profiling, _FromTag, S) when S#state.profiling -> + ptrac(S#state.rootset, false, all()), + call_trace_for_all(false), + multi_schedule(), + io:format("eprof: Stop profiling~n",[]), + ets:delete(S#state.table, nofunc), + {reply, profiling_stopped, S#state{profiling = false}}; + +handle_call(stop_profiling, _FromTag, S) -> + {reply, profiling_already_stopped, S}; + +handle_call({profile, Rootset, M, F, A}, FromTag, S) -> + io:format("eprof: Starting profiling..... ~n", []), + maybe_delete(S#state.table), + ptrac(S#state.rootset, false, all()), + flush_receive(), + put(replyto, FromTag), + Tab = ets:new(eprof, [set, public]), + P = spawn_link(eprof, call, [self(), M, F, A]), + case ptrac([P|Rootset], true, all()) of + true -> + uni_schedule(), + call_trace_for_all(true), + P ! {self(),go}, + {noreply, #state{table = Tab, + profiling = true, + rootset = [P|Rootset]}}; + false -> + exit(P, kill), + erase(replyto), + {reply, error, #state{}} + end; + +handle_call(dump, _FromTag, S) -> + {reply, dump(S#state.table), S}; + +handle_call(analyse, _FromTag, S) -> + {reply, analyse(S), S}; + +handle_call(total_analyse, _FromTag, S) -> + {reply, total_analyse(S), S}; + +handle_call(stop, _FromTag, S) -> + multi_schedule(), + {stop, normal, stopped, S}. + +%%%%%%%%%%%%%%%%%%% + +handle_info({trace_ts,_From,_Op,_Func,_Time}=M, S0) when S0#state.profiling -> + Start = erlang:now(), + #state{table=Tab,pop=PrevOp0,ptime=PrevTime0,pfunc=PrevFunc0, + overhead=Overhead0} = S0, + {PrevFunc,PrevOp,PrevTime} = do_messages(M, Tab, PrevFunc0, PrevOp0, PrevTime0), + Overhead = Overhead0 + subtr(erlang:now(), Start), + S = S0#state{overhead=Overhead,pfunc=PrevFunc,pop=PrevOp,ptime=PrevTime}, + {noreply,S}; + +handle_info({trace_ts, From, _, _, _}, S) when not S#state.profiling -> + ptrac([From], false, all()), + {noreply, S}; + +handle_info({_P, {answer, A}}, S) -> + ptrac(S#state.rootset, false, all()), + io:format("eprof: Stop profiling~n",[]), + {From,_Tag} = get(replyto), + catch unlink(From), + ets:delete(S#state.table, nofunc), + gen_server:reply(erase(replyto), {ok, A}), + multi_schedule(), + {noreply, S#state{profiling = false, + rootset = []}}; + +handle_info({'EXIT', P, Reason}, + #state{profiling=true,proc=P,table=T,rootset=RootSet}) -> + maybe_delete(T), + ptrac(RootSet, false, all()), + multi_schedule(), + io:format("eprof: Profiling failed\n",[]), + case erase(replyto) of + undefined -> + {noreply, #state{}}; + FromTag -> + gen_server:reply(FromTag, {error, Reason}), + {noreply, #state{}} + end; + +handle_info({'EXIT',_P,_Reason}, S) -> + {noreply, S}. + +uni_schedule() -> + erlang:system_flag(multi_scheduling, block). + +multi_schedule() -> + erlang:system_flag(multi_scheduling, unblock). + +%%%%%%%%%%%%%%%%%% + +call(Top, M, F, A) -> + receive + {Top,go} -> + Top ! {self(), {answer, apply(M,F,A)}} + end. + +call_trace_for_all(Flag) -> + erlang:trace_pattern(on_load, Flag, [local]), + erlang:trace_pattern({'_','_','_'}, Flag, [local]). + +ptrac([P|T], How, Flags) when is_pid(P) -> + case dotrace(P, How, Flags) of + true -> + ptrac(T, How, Flags); + false when How -> + false; + false -> + ptrac(T, How, Flags) + end; + +ptrac([P|T], How, Flags) when is_atom(P) -> + case whereis(P) of + undefined when How -> + false; + undefined when not How -> + ptrac(T, How, Flags); + Pid -> + ptrac([Pid|T], How, Flags) + end; + +ptrac([H|_],_How,_Flags) -> + io:format("** eprof bad process ~w~n",[H]), + false; + +ptrac([],_,_) -> true. + +dotrace(P, How, What) -> + case (catch erlang:trace(P, How, What)) of + 1 -> + true; + _Other when not How -> + true; + _Other -> + io:format("** eprof: bad process: ~p,~p,~p~n", [P,How,What]), + false + end. + +all() -> [call,arity,return_to,running,timestamp,set_on_spawn]. + +total_analyse(#state{table=notable}) -> + nothing_to_analyse; +total_analyse(S) -> + #state{table = T, overhead = Overhead} = S, + QH = qlc:q([{{From,Mfa},Time,Count} || + {[From|Mfa],Time,Count} <- ets:table(T)]), + Pcalls = reverse(keysort(2, replicas(qlc:eval(QH)))), + Time = collect_times(Pcalls), + format("FUNCTION~44s TIME ~n", ["CALLS"]), + printit(Pcalls, Time), + format("\nTotal time: ~.2f\n", [Time / 1000000]), + format("Measurement overhead: ~.2f\n", [Overhead / 1000000]). + +analyse(#state{table=notable}) -> + nothing_to_analyse; +analyse(S) -> + #state{table = T, overhead = Overhead} = S, + Pids = ordsets:from_list(flatten(ets:match(T, {['$1'|'_'],'_', '_'}))), + Times = sum(ets:match(T, {'_','$1', '_'})), + format("FUNCTION~44s TIME ~n", ["CALLS"]), + do_pids(Pids, T, 0, Times), + format("\nTotal time: ~.2f\n", [Times / 1000000]), + format("Measurement overhead: ~.2f\n", [Overhead / 1000000]). + +do_pids([Pid|Tail], T, AckTime, Total) -> + Pcalls = + reverse(keysort(2, to_tups(ets:match(T, {[Pid|'$1'], '$2','$3'})))), + Time = collect_times(Pcalls), + PercentTotal = 100 * (divide(Time, Total)), + format("~n****** Process ~w -- ~s % of profiled time *** ~n", + [Pid, fpf(PercentTotal)]), + printit(Pcalls, Time), + do_pids(Tail, T, AckTime + Time, Total); +do_pids([], _, _, _) -> + ok. + +printit([],_) -> ok; +printit([{{Mod,Fun,Arity}, Time, Calls} |Tail], ProcTime) -> + format("~s ~s ~s % ~n", [ff(Mod,Fun,Arity), fint(Calls), + fpf(100*(divide(Time,ProcTime)))]), + printit(Tail, ProcTime); +printit([{{_,{Mod,Fun,Arity}}, Time, Calls} |Tail], ProcTime) -> + format("~s ~s ~s % ~n", [ff(Mod,Fun,Arity), fint(Calls), + fpf(100*(divide(Time,ProcTime)))]), + printit(Tail, ProcTime); +printit([_|T], Time) -> + printit(T, Time). + +ff(Mod,Fun,Arity) -> + pad(flatten(io_lib:format("~w:~w/~w", [Mod,Fun, Arity])),45). + +pad(Str, Len) -> + Strlen = length(Str), + if + Strlen > Len -> strip_tail(Str, 45); + true -> lists:append(Str, mklist(Len-Strlen)) + end. + +strip_tail([_|_], 0) ->[]; +strip_tail([H|T], I) -> [H|strip_tail(T, I-1)]; +strip_tail([],_I) -> []. + +fpf(F) -> strip_tail(flatten(io_lib:format("~w", [round(F)])), 5). +fint(Int) -> pad(flatten(io_lib:format("~w",[Int])), 10). + +mklist(0) -> []; +mklist(I) -> [$ |mklist(I-1)]. + +to_tups(L) -> lists:map(fun(List) -> erlang:list_to_tuple(List) end, L). + +divide(X,Y) -> X / Y. + +collect_times([]) -> 0; +collect_times([Tup|Tail]) -> element(2, Tup) + collect_times(Tail). + +dump(T) -> + L = ets:tab2list(T), + format(L). + +format([H|T]) -> + format("~p~n", [H]), format(T); +format([]) -> ok. + +format(F, A) -> + io:format(F,A), + case get(fd) of + undefined -> ok; + Fd -> io:format(Fd, F,A) + end. + +maybe_delete(T) -> + catch ets:delete(T). + +sum([[H]|T]) -> H + sum(T); +sum([]) -> 0. + +replicas(L) -> + replicas(L, []). + +replicas([{{Pid, {Mod,Fun,Arity}}, Ack,Calls} |Tail], Result) -> + case search({Mod,Fun,Arity},Result) of + false -> + replicas(Tail, [{{Pid, {Mod,Fun,Arity}}, Ack,Calls} |Result]); + {Ack2, Calls2} -> + Result2 = del({Mod,Fun,Arity}, Result), + replicas(Tail, [{{Pid, {Mod,Fun,Arity}}, + Ack+Ack2,Calls+Calls2} |Result2]) + end; + +replicas([_|T], Ack) -> %% Whimpy + replicas(T, Ack); + +replicas([], Res) -> Res. + +search(Key, [{{_,Key}, Ack, Calls}|_]) -> + {Ack, Calls}; +search(Key, [_|T]) -> + search(Key, T); +search(_Key,[]) -> false. + +del(Key, [{{_,Key},_Ack,_Calls}|T]) -> + T; +del(Key, [H | Tail]) -> + [H|del(Key, Tail)]; +del(_Key,[]) -> []. + +flush_receive() -> + receive + {trace_ts, From, _, _, _} when is_pid(From) -> + ptrac([From], false, all()), + flush_receive(); + _ -> + flush_receive() + after 0 -> + ok + end. + +code_change(_OldVsn, State, _Extra) -> + {ok,State}. diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl new file mode 100644 index 0000000000..155965a65a --- /dev/null +++ b/lib/tools/src/fprof.erl @@ -0,0 +1,2762 @@ +%% +%% %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 : fprof.erl +%%% Author : Raimo Niskanen +%%% Purpose : File tracing profiling tool wich accumulated times. +%%% Created : 18 Jun 2001 by Raimo Niskanen +%%%---------------------------------------------------------------------- + +-module(fprof). +-author('raimo@erix.ericsson.se'). + +%% External exports +-export([ + apply/2, apply/3, apply/4, + start/0, stop/0, stop/1, + trace/1, trace/2, + profile/0, profile/1, profile/2, + analyse/0, analyse/1, analyse/2]). +%% Debug functions +-export([get_state/0, + save_profile/0, save_profile/1, save_profile/2, + load_profile/0, load_profile/1, load_profile/2, + code_change/0]). + +%% Debug exports +-export([call/1, just_call/1, reply/2]). +-export([trace_off/0, trace_on/3]). +-export([getopts/2, setopts/1]). +-export([println/5, print_callers/2, print_func/2, print_called/2]). +-export([trace_call_collapse/1]). +-export([parsify/1]). + +%% Internal exports +-export(['$code_change'/1]). + + + +-define(FNAME_WIDTH, 72). +-define(NR_WIDTH, 15). + +-define(TRACE_FILE, "fprof.trace"). +-define(DUMP_FILE, "fprof.dump"). +-define(PROFILE_FILE, "fprof.profile"). +-define(ANALYSIS_FILE, "fprof.analysis"). + +-define(FPROF_SERVER, fprof_server). +-define(FPROF_SERVER_TIMEOUT, infinity). + + + +-define(debug, 9). +%-define(debug, 0). +-ifdef(debug). +dbg(Level, F, A) when Level >= ?debug -> + io:format(F, A), + ok; +dbg(_, _, _) -> + ok. +-define(dbg(Level, F, A), dbg((Level), (F), (A))). +-else. +-define(dbg(Level, F, A), ok). +-endif. + + + +%%%---------------------------------------------------------------------- +%%% Higher order API functions +%%%---------------------------------------------------------------------- + + + +apply({M, F} = Function, Args) + when is_atom(M), is_atom(F), is_list(Args) -> + apply_1(Function, Args, []); +apply(Fun, Args) + when is_function(Fun), is_list(Args) -> + apply_1(Fun, Args, []); +apply(A, B) -> + erlang:error(badarg, [A, B]). + +apply(M, F, Args) when is_atom(M), is_atom(F), is_list(Args) -> + apply_1({M, F}, Args, []); +apply({M, F} = Function, Args, Options) + when is_atom(M), is_atom(F), is_list(Args), is_list(Options) -> + apply_1(Function, Args, Options); +apply(Fun, Args, Options) + when is_function(Fun), is_list(Args), is_list(Options) -> + apply_1(Fun, Args, Options); +apply(A, B, C) -> + erlang:error(badarg, [A, B, C]). + +apply(Module, Function, Args, Options) + when is_atom(Module), is_atom(Function), is_list(Args), is_list(Options) -> + apply_1({Module, Function}, Args, Options); +apply(A, B, C, D) -> + erlang:error(badarg, [A, B, C, D]). + + +apply_1(Function, Args, Options) -> + {[_, Procs, Continue], Options_1} = + getopts(Options, [start, procs, continue]), + Procs_1 = case Procs of + [{procs, P}] when is_list(P) -> + P; + _ -> + [] + end, + case Continue of + [] -> + apply_start_stop(Function, Args, Procs_1, Options_1); + [continue] -> + apply_continue(Function, Args, Procs_1, Options_1); + _ -> + erlang:error(badarg, [Function, Args, Options]) + end. + + + +apply_start_stop(Function, Args, Procs, Options) -> + Ref = make_ref(), + Parent = self(), + Child = + spawn( + fun() -> + MRef = erlang:monitor(process, Parent), + receive + {Parent, Ref, start_trace} -> + case trace([start, + {procs, [Parent | Procs]} + | Options]) of + ok -> + catch Parent ! {self(), Ref, trace_started}, + receive + {Parent, Ref, stop_trace} -> + trace([stop]), + catch Parent + ! {self(), Ref, trace_stopped}, + done; + {'DOWN', MRef, _, _, _} -> + trace([stop]) + end; + {error, Reason} -> + exit(Reason) + end; + {'DOWN', MRef, _, _, _} -> + done + end + end), + MRef = erlang:monitor(process, Child), + catch Child ! {self(), Ref, start_trace}, + receive + {Child, Ref, trace_started} -> + try erlang:apply(Function, Args) + after + catch Child ! {self(), Ref, stop_trace}, + receive + {Child, Ref, trace_stopped} -> + receive + {'DOWN', MRef, _, _, _} -> + ok + end; + {'DOWN', MRef, _, _, _} -> + trace([stop]) + end + end; + {'DOWN', MRef, _, _, Reason} -> + exit(Reason) + end. + +apply_continue(Function, Args, Procs, Options) -> + Ref = make_ref(), + Parent = self(), + Child = + spawn( + fun() -> + MRef = erlang:monitor(process, Parent), + receive + {Parent, Ref, start_trace} -> + case trace([start, + {procs, [Parent | Procs]} + | Options]) of + ok -> + exit({Ref, trace_started}); + {error, Reason} -> + exit(Reason) + end; + {'DOWN', MRef, _, _, _} -> + done + end + end), + MRef = erlang:monitor(process, Child), + catch Child ! {self(), Ref, start_trace}, + receive + {'DOWN', MRef, _, _, {Ref, trace_started}} -> + erlang:apply(Function, Args); + {'DOWN', MRef, _, _, Reason} -> + exit(Reason) + end. + + + +%%%---------------------------------------------------------------------- +%%% Requests to ?FPROF_SERVER +%%%---------------------------------------------------------------------- + +-record(trace_start, {procs, % List of processes + mode, % normal | verbose + type, % file | tracer + dest}). % Filename | Pid/Port + +-record(trace_stop, {}). + +% -record(open_out, {file}). + +% -record(close_out, {}). + +-record(profile, {src, % Filename + group_leader, % IoPid + dump, % Filename | IoPid + flags}). % List + +-record(profile_start, {group_leader, % IoPid + dump, % Filename | IoPid + flags}). % List + +-record(profile_stop, {}). + +-record(analyse, {group_leader, % IoPid + dest, % Filename | IoPid + flags, % List + cols, % Integer + callers, % Boolean + sort, % acc_r | own_r + totals, % Boolean + details}). % Boolean + +-record(stop, { + reason}). + + + +%%--------------- +%% Debug requests +%%--------------- + +-record(get_state, {}). + +-record(save_profile, {file}). + +-record(load_profile, {file}). + + + +%%%---------------------------------------------------------------------- +%%% Basic API functions +%%%---------------------------------------------------------------------- + + + +trace(start, Filename) -> + trace([start, {file, Filename}]); +trace(verbose, Filename) -> + trace([start, verbose, {file, Filename}]); +trace(Option, Value) when is_atom(Option) -> + trace([{Option, Value}]); +trace(Option, Value) -> + erlang:error(badarg, [Option, Value]). + +trace(stop) -> + %% This shortcut is present to minimize the number of undesired + %% function calls at the end of the trace. + call(#trace_stop{}); +trace(verbose) -> + trace([start, verbose]); +trace([stop]) -> + %% This shortcut is present to minimize the number of undesired + %% function calls at the end of the trace. + call(#trace_stop{}); +trace({Opt, _Val} = Option) when is_atom(Opt) -> + trace([Option]); +trace(Option) when is_atom(Option) -> + trace([Option]); +trace(Options) when is_list(Options) -> + case getopts(Options, + [start, stop, procs, verbose, file, tracer, cpu_time]) of + {[[], [stop], [], [], [], [], []], []} -> + call(#trace_stop{}); + {[[start], [], Procs, Verbose, File, Tracer, CpuTime], []} -> + {Type, Dest} = case {File, Tracer} of + {[], [{tracer, Pid} = T]} + when is_pid(Pid); is_port(Pid) -> + T; + {[file], []} -> + {file, ?TRACE_FILE}; + {[{file, []}], []} -> + {file, ?TRACE_FILE}; + {[{file, _} = F], []} -> + F; + {[], []} -> + {file, ?TRACE_FILE}; + _ -> + erlang:error(badarg, [Options]) + end, + V = case Verbose of + [] -> normal; + [verbose] -> verbose; + [{verbose, true}] -> verbose; + [{verbose, false}] -> normal; + _ -> erlang:error(badarg, [Options]) + end, + CT = case CpuTime of + [] -> wallclock; + [cpu_time] -> cpu_time; + [{cpu_time, true}] -> cpu_time; + [{cpu_time, false}] -> wallclock; + _ -> erlang:error(badarg, [Options]) + end, + call(#trace_start{procs = case Procs of + [] -> + [self()]; + [{procs, P}] when is_list(P) -> + P; + [{procs, P}] -> + [P]; + _ -> + erlang:error(badarg, [Options]) + end, + mode = {V, CT}, + type = Type, + dest = Dest}); + _ -> + erlang:error(badarg, [Options]) + end; +trace(Options) -> + erlang:error(badarg, [Options]). + + + +profile() -> + profile([]). + +profile(Option, Value) when is_atom(Option) -> + profile([{Option, Value}]); +profile(Option, Value) -> + erlang:error(badarg, [Option, Value]). + +profile(Option) when is_atom(Option) -> + profile([Option]); +profile({Opt, _Val} = Option) when is_atom(Opt) -> + profile([Option]); +profile(Options) when is_list(Options) -> + case getopts(Options, [start, stop, file, dump, append]) of + {[Start, [], File, Dump, Append], []} -> + {Target, Flags} = + case {Dump, Append} of + {[], []} -> + {[], []}; + {[dump], []} -> + {group_leader(), []}; + {[{dump, []}], []} -> + {?DUMP_FILE, []}; + {[{dump, []}], [append]} -> + {?DUMP_FILE, [append]}; + {[{dump, D}], [append]} when is_pid(D) -> + erlang:error(badarg, [Options]); + {[{dump, D}], [append]} -> + {D, [append]}; + {[{dump, D}], []} -> + {D, []}; + _ -> + erlang:error(badarg, [Options]) + end, + case {Start, File} of + {[start], []} -> + call(#profile_start{group_leader = group_leader(), + dump = Target, + flags = Flags}); + {[], _} -> + Src = + case File of + [] -> + ?TRACE_FILE; + [file] -> + ?TRACE_FILE; + [{file, []}] -> + ?TRACE_FILE; + [{file, F}] -> + F; + _ -> + erlang:error(badarg, [Options]) + end, + call(#profile{src = Src, + group_leader = group_leader(), + dump = Target, + flags = Flags}); + _ -> + erlang:error(badarg, [Options]) + end; + {[[], [stop], [], [], []], []} -> + call(#profile_stop{}); + _ -> + erlang:error(badarg, [Options]) + end; +profile(Options) -> + erlang:error(badarg, [Options]). + + + +analyse() -> + analyse([]). + +analyse(Option, Value) when is_atom(Option) -> + analyse([{Option, Value}]); +analyse(Option, Value) -> + erlang:error(badarg, [Option, Value]). + +analyse(Option) when is_atom(Option) -> + analyse([Option]); +analyse({Opt, _Val} = Option) when is_atom(Opt) -> + analyse([Option]); +analyse(Options) when is_list(Options) -> + case getopts(Options, + [dest, append, cols, callers, no_callers, + sort, totals, details, no_details]) of + {[Dest, Append, Cols, Callers, NoCallers, + Sort, Totals, Details, NoDetails], []} -> + {Target, Flags} = + case {Dest, Append} of + {[], []} -> + {group_leader(), []}; + {[dest], []} -> + {group_leader(), []}; + {[{dest, []}], []} -> + {?ANALYSIS_FILE, []}; + {[{dest, []}], [append]} -> + {?ANALYSIS_FILE, [append]}; + {[{dest, F}], [append]} when is_pid(F) -> + erlang:error(badarg, [Options]); + {[{dest, F}], [append]} -> + {F, [append]}; + {[{dest, F}], []} -> + {F, []}; + _ -> + erlang:error(badarg, [Options]) + end, + call(#analyse{group_leader = group_leader(), + dest = Target, + flags = Flags, + cols = case Cols of + [] -> + 80; + [{cols, C}] when is_integer(C), C > 0 -> + C; + _ -> + erlang:error(badarg, [Options]) + end, + callers = case {Callers, NoCallers} of + {[], []} -> + true; + {[callers], []} -> + true; + {[{callers, true}], []} -> + true; + {[{callers, false}], []} -> + false; + {[], [no_callers]} -> + false; + _ -> + erlang:error(badarg, [Options]) + end, + sort = case Sort of + [] -> + acc; + [{sort, acc}] -> + acc; + [{sort, own}] -> + own; + _ -> + erlang:error(badarg, [Options]) + end, + totals = case Totals of + [] -> + false; + [totals] -> + true; + [{totals, true}] -> + true; + [{totals, false}] -> + false; + _ -> + erlang:error(badarg, [Options]) + end, + details = case {Details, NoDetails} of + {[], []} -> + true; + {[details], []} -> + true; + {[{details, true}], []} -> + true; + {[{details, false}], []} -> + false; + {[], [no_details]} -> + false; + _ -> + erlang:error(badarg, [Options]) + end}); + _ -> + erlang:error(badarg, [Options]) + end; +analyse(Options) -> + erlang:error(badarg, [Options]). + + + +%%---------------- +%% Debug functions +%%---------------- + + + +get_state() -> + just_call(#get_state{}). + + + +save_profile() -> + save_profile([]). + +save_profile(Option, Value) when is_atom(Option) -> + save_profile([{Option, Value}]); +save_profile(Option, Value) -> + erlang:error(badarg, [Option, Value]). + +save_profile(Option) when is_atom(Option) -> + save_profile([Option]); +save_profile(Options) when is_list(Options) -> + case getopts(Options, [file]) of + {[File], []} -> + call(#save_profile{file = case File of + [] -> + ?PROFILE_FILE; + [{file, F}] -> + F; + _ -> + erlang:error(badarg, [Options]) + end}); + _ -> + erlang:error(badarg, [Options]) + end; +save_profile(Options) -> + erlang:error(badarg, [Options]). + + + +load_profile() -> + load_profile([]). + +load_profile(Option, Value) when is_atom(Option) -> + load_profile([{Option, Value}]); +load_profile(Option, Value) -> + erlang:error(badarg, [Option, Value]). + +load_profile(Option) when is_atom(Option) -> + load_profile([Option]); +load_profile(Options) when is_list(Options) -> + case getopts(Options, [file]) of + {[File], []} -> + call(#load_profile{file = case File of + [] -> + ?PROFILE_FILE; + [{file, F}] -> + F; + _ -> + erlang:error(badarg, [Options]) + end}); + _ -> + erlang:error(badarg, [Options]) + end; +load_profile(Options) -> + erlang:error(badarg, [Options]). + + + +code_change() -> + just_call('$code_change'). + + + +%%%---------------------------------------------------------------------- +%%% ETS table record definitions +%%% The field 'id' must be first in these records; +%%% it is the common ets table index field. +%%%---------------------------------------------------------------------- + +-record(clocks, { + id, + cnt = 0, % Number of calls + own = 0, % Own time (wall clock) + acc = 0}). % Accumulated time : own + subfunctions (wall clock) + +-record(proc, { + id, + parent, + spawned_as, % Spawned MFArgs + init_log = [], % List of first calls, head is newest + init_cnt = 2}). % First calls counter, counts down to 0 + +-record(misc, {id, + data}). + + + +%% Analysis summary record +-record(funcstat, { + callers_sum, % #clocks{id = {Pid, Caller, Func}} + called_sum, % #clocks{id = {Pid, Caller, Func}} + callers = [], % [#clocks{}, ...] + called = []}). % [#clocks{}, ...] + + + +%%%---------------------------------------------------------------------- +%%% ?FPROF_SERVER +%%%---------------------------------------------------------------------- + +%%%------------------- +%%% Exported functions +%%%------------------- + +%% Start server process +start() -> + spawn_3step( + fun () -> + try register(?FPROF_SERVER, self()) of + true -> + process_flag(trap_exit, true), + {{ok, self()}, loop} + catch + error:badarg -> + {{error, {already_started, whereis(?FPROF_SERVER)}}, + already_started} + end + end, + fun (X) -> + X + end, + fun (loop) -> + put(trace_state, idle), + put(profile_state, {idle, undefined}), + put(pending_stop, []), + server_loop([]); + (already_started) -> + ok + end). + + + +%% Stop server process + +stop() -> + stop(normal). + +stop(kill) -> + case whereis(?FPROF_SERVER) of + undefined -> + ok; + Pid -> + exit(Pid, kill), + ok + end; +stop(Reason) -> + just_call(#stop{reason = Reason}), + ok. + + + +%%%------------------------ +%%% Client helper functions +%%%------------------------ + +%% Send request to server process and return the server's reply. +%% First start server if it ain't started. +call(Request) -> + case whereis(?FPROF_SERVER) of + undefined -> + start(), + just_call(Request); + Server -> + just_call(Server, Request) + end. + +%% Send request to server process, and return the server's reply. +%% Returns {'EXIT', Pid, Reason} if the server dies during the +%% call, or if it wasn't started. +just_call(Request) -> + just_call(whereis(?FPROF_SERVER), Request). + +just_call(undefined, _) -> + {'EXIT', ?FPROF_SERVER, noproc}; +just_call(Pid, Request) -> + Mref = erlang:monitor(process, Pid), + receive + {'DOWN', Mref, _, _, Reason} -> + {'EXIT', Pid, Reason} + after 0 -> + Tag = {Mref, self()}, + {T, Demonitor} = case Request of + #stop{} -> + {?FPROF_SERVER_TIMEOUT, false}; + _ -> + {0, true} + end, + %% io:format("~p request: ~p~n", [?MODULE, Request]), + catch Pid ! {?FPROF_SERVER, Tag, Request}, + receive + {?FPROF_SERVER, Mref, Reply} -> + case Demonitor of + true -> erlang:demonitor(Mref); + false -> ok + end, + receive {'DOWN', Mref, _, _, _} -> ok after T -> ok end, + Reply; + {'DOWN', Mref, _, _, Reason} -> + receive {?FPROF_SERVER, Mref, _} -> ok after T -> ok end, + {'EXIT', Pid, Reason} + after ?FPROF_SERVER_TIMEOUT -> + timeout + end + end. + + + +%%%------------------------ +%%% Server helper functions +%%%------------------------ + +%% Return the reply to the client's request. +reply({Mref, Pid}, Reply) when is_reference(Mref), is_pid(Pid) -> + catch Pid ! {?FPROF_SERVER, Mref, Reply}, + ok. + + + +server_loop(State) -> + receive + {?FPROF_SERVER, {Mref, Pid} = Tag, '$code_change'} + when is_reference(Mref), is_pid(Pid) -> + reply(Tag, ok), + ?MODULE:'$code_change'(State); + {?FPROF_SERVER, {Mref, Pid} = Tag, Request} + when is_reference(Mref), is_pid(Pid) -> + server_loop(handle_req(Request, Tag, State)); + Other -> + server_loop(handle_other(Other, State)) + end. + +%-export. +'$code_change'(State) -> + case lists:keysearch(time, 1, module_info(compile)) of + {value, {time, {Y, M, D, HH, MM, SS}}} -> + io:format("~n~w: code change to compile time " + ++"~4..0w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w~n", + [?MODULE, Y, M, D, HH, MM, SS]); + false -> + ok + end, + server_loop(State). + + + +%% Server help function that stops the server iff the +%% sub state machines are in proper states. Sends the reply +%% to all waiting clients. +try_pending_stop(State) -> + case {get(trace_state), get(profile_state), get(pending_stop)} of + {idle, {idle, _}, [_|_] = PendingStop} -> + Reason = get(stop_reason), + Reply = result(Reason), + lists:foreach( + fun (Tag) -> + reply(Tag, Reply) + end, + PendingStop), + exit(Reason); + _ -> + State + end. + +%%------------------ +%% Server handle_req +%%------------------ + +handle_req(#trace_start{procs = Procs, + mode = Mode, + type = file, + dest = Filename}, Tag, State) -> + case {get(trace_state), get(pending_stop)} of + {idle, []} -> + trace_off(), + Port = open_dbg_trace_port(file, Filename), + case trace_on(Procs, Port, Mode) of + ok -> + put(trace_state, running), + put(trace_type, file), + put(trace_pid, Port), + reply(Tag, ok), + State; + Error -> + reply(Tag, Error), + State + end; + _ -> + reply(Tag, {error, already_tracing}), + State + end; +handle_req(#trace_start{procs = Procs, + mode = Mode, + type = tracer, + dest = Tracer}, Tag, State) -> + case {get(trace_state), get(pending_stop)} of + {idle, []} -> + trace_off(), + case trace_on(Procs, Tracer, Mode) of + ok -> + put(trace_state, running), + put(trace_type, tracer), + put(trace_pid, Tracer), + reply(Tag, ok), + State; + Error -> + reply(Tag, Error), + State + end; + _ -> + reply(Tag, {error, already_tracing}), + State + end; + +handle_req(#trace_stop{}, Tag, State) -> + case get(trace_state) of + running -> + TracePid = get(trace_pid), + trace_off(), + case erase(trace_type) of + file -> + catch erlang:port_close(TracePid), + put(trace_state, stopping), + put(trace_tag, Tag), + State; + tracer -> + erase(trace_pid), + put(trace_state, idle), + case {get(profile_state), get(profile_type), + get(profile_pid)} of + {running, tracer, TracePid} -> + exit(TracePid, normal), + put(profile_tag, Tag), + State; + _ -> + reply(Tag, ok), + try_pending_stop(State) + end + end; + _ -> + reply(Tag, {error, not_tracing}), + State + end; + +handle_req(#profile{src = Filename, + group_leader = GroupLeader, + dump = Dump, + flags = Flags}, Tag, State) -> + case {get(profile_state), get(pending_stop)} of + {{idle, _}, []} -> + case ensure_open(Dump, [write | Flags]) of + {already_open, DumpPid} -> + put(profile_dump, DumpPid), + put(profile_close_dump, false); + {ok, DumpPid} -> + put(profile_dump, DumpPid), + put(profile_close_dump, true); + {error, _} = Error -> + reply(Tag, Error), + State + end, + Table = ets:new(?MODULE, [set, public, {keypos, #clocks.id}]), + Pid = spawn_link_dbg_trace_client(Filename, Table, + GroupLeader, + get(profile_dump)), + put(profile_state, running), + put(profile_type, file), + put(profile_pid, Pid), + put(profile_tag, Tag), + put(profile_table, Table), + State; + _ -> + reply(Tag, {error, already_profiling}), + State + end; + +handle_req(#profile_start{group_leader = GroupLeader, + dump = Dump, + flags = Flags}, Tag, State) -> + case {get(profile_state), get(pending_stop)} of + {{idle, _}, []} -> + case ensure_open(Dump, [write | Flags]) of + {already_open, DumpPid} -> + put(profile_dump, DumpPid), + put(profile_close_dump, false); + {ok, DumpPid} -> + put(profile_dump, DumpPid), + put(profile_close_dump, true); + {error, _} = Error -> + reply(Tag, Error), + State + end, + Table = ets:new(?MODULE, [set, public, {keypos, #clocks.id}]), + Pid = spawn_link_trace_client(Table, GroupLeader, + get(profile_dump)), + put(profile_state, running), + put(profile_type, tracer), + put(profile_pid, Pid), + put(profile_table, Table), + reply(Tag, {ok, Pid}), + State; + _ -> + reply(Tag, {error, already_profiling}), + State + end; + +handle_req(#profile_stop{}, Tag, State) -> + case {get(profile_state), get(profile_type)} of + {running, tracer} -> + ProfilePid = get(profile_pid), + case {get(trace_state), get(trace_type), get(trace_pid)} of + {running, tracer, ProfilePid} -> + trace_off(), + erase(trace_type), + erase(trace_pid), + put(trace_state, idle); + _ -> + ok + end, + exit(ProfilePid, normal), + put(profile_tag, Tag), + State; + {running, file} -> + reply(Tag, {error, profiling_file}), + State; + {_, _} -> + reply(Tag, {error, not_profiling}), + State + end; + +handle_req(#analyse{dest = Dest, + flags = Flags} = Request, Tag, State) -> + case get(profile_state) of + {idle, undefined} -> + reply(Tag, {error, no_profile}), + State; + {idle, _} -> + case ensure_open(Dest, [write | Flags]) of + {error, _} = Error -> + reply(Tag, Error), + State; + {DestState, DestPid} -> + ProfileTable = get(profile_table), + reply(Tag, + spawn_3step( + fun() -> + do_analyse(ProfileTable, + Request#analyse{dest = DestPid}) + end, + fun(Result) -> + {Result,finish} + end, + fun(finish) -> + ok + end)), + case DestState of + already_open -> + ok; + ok -> + file:close(DestPid) + end, + State + end; + _ -> + reply(Tag, {error, profiling}), + State + end; + +handle_req(#stop{reason = Reason}, Tag, State) -> + PendingStop = get(pending_stop), + case PendingStop of + [] -> + put(stop_reason, Reason); + _ -> + ok + end, + put(pending_stop, [Tag | PendingStop]), + try_pending_stop(State); + +%%---------------------- +%% Server debug requests +%%---------------------- + +handle_req(#get_state{}, Tag, State) -> + reply(Tag, {ok, get()}), + State; + +handle_req(#save_profile{file = File}, Tag, State) -> + case get(profile_state) of + {idle, undefined} -> + reply(Tag, {error, no_profile}); + {idle, _} -> + reply(Tag, ets:tab2file(get(profile_table), File)), + State; + _ -> + reply(Tag, {error, profiling}), + State + end; + +handle_req(#load_profile{file = File}, Tag, State) -> + case get(profile_state) of + {idle, Result} -> + case ets:file2tab(File) of + {ok, Table} -> + put(profile_state, {idle, ok}), + case Result of + {error, no_profile} -> + ets:delete(put(profile_table, Table)); + _ -> + put(profile_table, Table) + end, + reply(Tag, ok), + State; + Error -> + reply(Tag, Error), + State + end; + _ -> + reply(Tag, {error, profiling}), + State + end; + + + +handle_req(Request, Tag, State) -> + io:format("~n~p:handle_req, unknown request - ~p~n", + [?MODULE, Request]), + reply(Tag, {error, unknown_request}), + State. + +%%-------------------- +%% Server handle_other +%%-------------------- + +handle_other({'EXIT', Pid, Reason} = Other, State) when is_pid(Pid); is_port(Pid) -> + case {get(trace_state), get(trace_pid)} of + {running, Pid} -> + trace_off(), + io:format("~n~p:handle_other, unexpected ~p (trace_pid)~n", + [?MODULE, Other]), + put(trace_state, idle), + erase(trace_type), + erase(trace_pid), + try_pending_stop(State); + {stopping, Pid} -> + put(trace_state, idle), + erase(trace_pid), + reply(erase(trace_tag), result(Reason)), + try_pending_stop(State); + _ -> + case {get(profile_state), get(profile_pid)} of + {running, Pid} -> + Result = result(Reason), + put(profile_state, {idle, Result}), + erase(profile_type), + erase(profile_pid), + case erase(profile_close_dump) of + true -> + file:close(erase(profile_dump)); + false -> + erase(profile_dump) + end, + reply(erase(profile_tag), Result), + try_pending_stop(State); + _ -> + io:format("~n~p:handle_other, unexpected ~p~n", + [?MODULE, Other]), + State + end + end; + +handle_other(Other, State) -> + io:format("~p:handle_other, unknown - ~p", + [?MODULE, Other]), + State. + + + +%%%---------------------------------------------------------------------- +%%% Internal functions +%%%---------------------------------------------------------------------- + +result(normal) -> + ok; +result(Reason) -> + {error, Reason}. + +ensure_open(Pid, _Options) when is_pid(Pid) -> + {already_open, Pid}; +ensure_open([], _Options) -> + {already_open, undefined}; +ensure_open(Filename, Options) when is_atom(Filename); is_list(Filename) -> + file:open(Filename, Options). + +%%%--------------------------------- +%%% Fairly generic utility functions +%%%--------------------------------- + + + +%% getopts(List, Options)) -> {DecodedOptions, RestOptions} +%% +%% List = [Option] +%% Options = [OptionTag] +%% Option = OptionTag | OptionTuple +%% OptionTuple = tuple(), element(1, OptionTuple) == OptionTag +%% OptionTag = term() +%% OptionValue = term() +%% DecodedOptions = [OptionList] +%% OptionList = [Option] +%% RestOptions = [Option] +%% +%% Searches List for options with tags defined in Options. +%% Returns DecodedOptions containing one OptionList per +%% OptionTag in Options, and RestOptions which contains +%% all terms from List not matching any OptionTag. +%% +%% All returned lists preserve the order from Options and List. +%% +%% An example: +%% getopts([{f, 1}, e, {d, 2}, {c, 3, 4}, {b, 5}, a, b], +%% [a, b, c, d]) -> +%% {[[a], [{b, 5}, b],[{c, 3, 4}], [{d, 2}]], +%% [{f, 1}, e]} +%% +getopts(List, Options) when is_list(List), is_list(Options) -> + getopts_1(Options, List, []). + +getopts_1([], List, Result) -> + {lists:reverse(Result), List}; +getopts_1([Option | Options], List, Result) -> + {Optvals, Remaining} = getopts_2(List, Option, [], []), + getopts_1(Options, Remaining, [Optvals | Result]). + +getopts_2([], _Option, Result, Remaining) -> + {lists:reverse(Result), lists:reverse(Remaining)}; +getopts_2([Option | Tail], Option, Result, Remaining) -> + getopts_2(Tail, Option, [Option | Result], Remaining); +getopts_2([Optval | Tail], Option, Result, Remaining) + when element(1, Optval) =:= Option -> + getopts_2(Tail, Option, [Optval | Result], Remaining); +getopts_2([Other | Tail], Option, Result, Remaining) -> + getopts_2(Tail, Option, Result, [Other | Remaining]). + +%% setopts(Options) -> List +%% +%% The reverse of getopts, almost. +%% Re-creates (approximately) List from DecodedOptions in +%% getopts/2 above. The original order is not preserved, +%% but rather the order from Options. +%% +%% An example: +%% setopts([[a], [{b,5}, b], [{c, 3, 4}], [{d,2}]]) -> +%% [a, {b, 5}, b, {c, 3, 4}, {d, 2}] +%% +%% And a more generic example: +%% {D, R} = getopts(L, O), +%% L2 = setopts(D) ++ R +%% L2 will contain exactly the same terms as L, but not in the same order. +%% +setopts(Options) when is_list(Options) -> + lists:append(Options). + + + +spawn_3step(FunPrelude, FunAck, FunBody) -> + spawn_3step(spawn, FunPrelude, FunAck, FunBody). + +spawn_link_3step(FunPrelude, FunAck, FunBody) -> + spawn_3step(spawn_link, FunPrelude, FunAck, FunBody). + +spawn_3step(Spawn, FunPrelude, FunAck, FunBody) + when Spawn =:= spawn; Spawn =:= spawn_link -> + Parent = self(), + Ref = make_ref(), + Child = + erlang:Spawn( + fun() -> + Ack = FunPrelude(), + catch Parent ! {self(), Ref, Ack}, + MRef = erlang:monitor(process, Parent), + receive + {Parent, Ref, Go} -> + erlang:demonitor(MRef), + receive {'DOWN', MRef, _, _, _} -> ok + after 0 -> ok + end, + FunBody(Go); + {'DOWN', MRef, _, _, _} -> + ok + end + end), + MRef = erlang:monitor(process, Child), + receive + {Child, Ref, Ack} -> + erlang:demonitor(MRef), + receive {'DOWN', MRef, _, _, _} -> ok after 0 -> ok end, + try FunAck(Ack) of + {Result, Go} -> + catch Child ! {Parent, Ref, Go}, + Result + catch + Class:Reason -> + Stacktrace = erlang:get_stacktrace(), + catch exit(Child, kill), + erlang:raise(Class, Reason, Stacktrace) + end; + {'DOWN', MRef, _, _, Reason} -> + receive {Child, Ref, _Ack} -> ok after 0 -> ok end, + case Spawn of + spawn_link -> + receive {'EXIT', Reason} -> ok after 0 -> ok end; + spawn -> + ok + end, + exit(Reason) + end. + + + +%%%--------------------------------- +%%% Trace message handling functions +%%%--------------------------------- + +trace_off() -> + try erlang:trace_delivered(all) of + Ref -> receive {trace_delivered, all, Ref} -> ok end + catch + error:undef -> ok + end, + try erlang:trace(all, false, [all, cpu_timestamp]) + catch + error:badarg -> erlang:trace(all, false, [all]) + end, + erlang:trace_pattern(on_load, false, [local]), + erlang:trace_pattern({'_', '_', '_'}, false, [local]), + ok. + + + +trace_on(Procs, Tracer, {V, CT}) -> + case case CT of + cpu_time -> + try erlang:trace(all, true, [cpu_timestamp]) of _ -> ok + catch + error:badarg -> {error, not_supported} + end; + wallclock -> ok + end + of ok -> + MatchSpec = [{'_', [], [{message, {{cp, {caller}}}}]}], + erlang:trace_pattern(on_load, MatchSpec, [local]), + erlang:trace_pattern({'_', '_', '_'}, MatchSpec, [local]), + lists:foreach( + fun (P) -> + erlang:trace(P, true, [{tracer, Tracer} | trace_flags(V)]) + end, + Procs), + ok; + Error -> + Error + end. + + + +trace_flags(normal) -> + [call, return_to, + running, procs, garbage_collection, + arity, timestamp, set_on_spawn]; +trace_flags(verbose) -> + [call, return_to, + send, 'receive', + running, procs, garbage_collection, + timestamp, set_on_spawn]. + + + +%%%------------------------------------- +%%% Tracer process functions, for +%%% the 'dbg' tracer and for a lookalike +%%%------------------------------------- + +open_dbg_trace_port(Type, Spec) -> + Fun = dbg:trace_port(Type, Spec), + Fun(). + + + +spawn_link_dbg_trace_client(File, Table, GroupLeader, Dump) -> + case dbg:trace_client(file, File, + {fun handler/2, + {init, GroupLeader, Table, Dump}}) of + Pid when is_pid(Pid) -> + link(Pid), + Pid; + Other -> + exit(Other) + end. + + + + +spawn_link_trace_client(Table, GroupLeader, Dump) -> + Parent = self(), + spawn_link_3step( + fun() -> + process_flag(trap_exit, true), + {self(),go} + end, + fun(Ack) -> + Ack + end, + fun(go) -> + Init = {init, GroupLeader, Table, Dump}, + tracer_loop(Parent, fun handler/2, Init) + end). + +tracer_loop(Parent, Handler, State) -> + receive + Trace when element(1, Trace) =:= trace -> + tracer_loop(Parent, Handler, Handler(Trace, State)); + Trace when element(1, Trace) =:= trace_ts -> + tracer_loop(Parent, Handler, Handler(Trace, State)); + {'EXIT', Parent, Reason} -> + handler(end_of_trace, State), + exit(Reason); + _ -> + tracer_loop(Parent, Handler, State) + end. + + + +%%%--------------------------------- +%%% Trace message handling functions +%%%--------------------------------- + +handler(end_of_trace, {init, GroupLeader, Table, Dump}) -> + dump(Dump, start_of_trace), + dump(Dump, end_of_trace), + info(GroupLeader, Dump, "Empty trace!~n", []), + end_of_trace(Table, undefined), + done; +handler(end_of_trace, {error, Reason, _, GroupLeader, Dump}) -> + info(GroupLeader, Dump, "~nEnd of erroneous trace!~n", []), + exit(Reason); +handler(end_of_trace, {_, TS, GroupLeader, Table, Dump}) -> + dump(Dump, end_of_trace), + info(GroupLeader, Dump, "~nEnd of trace!~n", []), + end_of_trace(Table, TS), + done; +handler(Trace, {init, GroupLeader, Table, Dump}) -> + dump(Dump, start_of_trace), + info(GroupLeader, Dump, "Reading trace data...~n", []), + try trace_handler(Trace, Table, GroupLeader, Dump) of + TS -> + ets:insert(Table, #misc{id = first_ts, data = TS}), + ets:insert(Table, #misc{id = last_ts_n, data = {TS, 1}}), + {1, TS, GroupLeader, Table, Dump} + catch + Error -> + dump(Dump, {error, Error}), + end_of_trace(Table, undefined), + {error, Error, 1, GroupLeader, Dump} + end; +%% case catch trace_handler(Trace, Table, GroupLeader, Dump) of +%% {'EXIT', Reason} -> +%% dump(Dump, {error, Reason}), +%% end_of_trace(Table, undefined), +%% {error, Reason, 1, GroupLeader, Dump}; +%% TS -> +%% ets:insert(Table, #misc{id = first_ts, data = TS}), +%% ets:insert(Table, #misc{id = last_ts_n, data = {TS, 1}}), +%% {1, TS, GroupLeader, Table, Dump} +%% end; +handler(_, {error, Reason, M, GroupLeader, Dump}) -> + N = M+1, + info_dots(GroupLeader, Dump, N), + {error, Reason, N, GroupLeader, Dump}; +handler(Trace, {M, TS0, GroupLeader, Table, Dump}) -> + N = M+1, + info_dots(GroupLeader, Dump, N), + try trace_handler(Trace, Table, GroupLeader, Dump) of + TS -> + ets:insert(Table, #misc{id = last_ts_n, data = {TS, N}}), + {N, TS, GroupLeader, Table, Dump} + catch + Error -> + dump(Dump, {error, Error}), + end_of_trace(Table, TS0), + {error, Error, N, GroupLeader, Dump} + end. +%% case catch trace_handler(Trace, Table, GroupLeader, Dump) of +%% {'EXIT', Reason} -> +%% dump(Dump, {error, Reason}), +%% end_of_trace(Table, TS0), +%% {error, Reason, N, GroupLeader, Dump}; +%% TS -> +%% ets:insert(Table, #misc{id = last_ts_n, data = {TS, N}}), +%% {N, TS, GroupLeader, Table, Dump} +%% end. + + + +end_of_trace(Table, TS) -> + %% + %% Close all process stacks, as if the processes exited. + %% + Procs = get(), + put(table, Table), + ?dbg(2, "get() -> ~p~n", [Procs]), + lists:map( + fun ({Pid, _}) when is_pid(Pid) -> + trace_exit(Table, Pid, TS) + end, + Procs), + erase(), + ok. + + + +info_dots(GroupLeader, GroupLeader, _) -> + ok; +info_dots(GroupLeader, _, N) -> + if (N rem 100000) =:= 0 -> + io:format(GroupLeader, ",~n", []); + (N rem 50000) =:= 0 -> + io:format(GroupLeader, ".~n", []); + (N rem 1000) =:= 0 -> + io:put_chars(GroupLeader, "."); + true -> + ok + end. + +info_suspect_call(GroupLeader, GroupLeader, _, _) -> + ok; +info_suspect_call(GroupLeader, _, Func, Pid) -> + io:format(GroupLeader, + "~nWarning: ~p called in ~p - trace may become corrupt!~n", + parsify([Func, Pid])). + +info(GroupLeader, GroupLeader, _, _) -> + ok; +info(GroupLeader, _, Format, List) -> + io:format(GroupLeader, Format, List). + +dump_stack(undefined, _, _) -> + false; +dump_stack(Dump, Stack, Term) -> + {Depth, _D} = + case Stack of + undefined -> + {0, 0}; + _ -> + case length(Stack) of + 0 -> + {0, 0}; + N -> + {N, length(hd(Stack))} + end + end, + io:format(Dump, "~s~p.~n", [lists:duplicate(Depth, " "), parsify(Term)]), + true. + +dump(undefined, _) -> + false; +dump(Dump, Term) -> + io:format(Dump, "~p.~n", [parsify(Term)]), + true. + + + +%%%---------------------------------- +%%% Profiling state machine functions +%%%---------------------------------- + + + +trace_handler({trace_ts, Pid, call, _MFA, _TS} = Trace, + _Table, _, Dump) -> + Stack = get(Pid), + dump_stack(Dump, Stack, Trace), + throw({incorrect_trace_data, ?MODULE, ?LINE, + [Trace, Stack]}); +trace_handler({trace_ts, Pid, call, {_M, _F, Arity} = Func, + {cp, CP}, TS} = Trace, + Table, GroupLeader, Dump) + when is_integer(Arity) -> + dump_stack(Dump, get(Pid), Trace), + case Func of + {erlang, trace, 3} -> + info_suspect_call(GroupLeader, Dump, Func, Pid); + {erlang, trace_pattern, 3} -> + info_suspect_call(GroupLeader, Dump, Func, Pid); + _ -> + ok + end, + trace_call(Table, Pid, Func, TS, CP), + TS; +trace_handler({trace_ts, Pid, call, {_M, _F, Args} = MFArgs, + {cp, CP}, TS} = Trace, + Table, _, Dump) + when is_list(Args) -> + dump_stack(Dump, get(Pid), Trace), + Func = mfarity(MFArgs), + trace_call(Table, Pid, Func, TS, CP), + TS; +%% +%% return_to +trace_handler({trace_ts, Pid, return_to, undefined, TS} = Trace, + Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_return_to(Table, Pid, undefined, TS), + TS; +trace_handler({trace_ts, Pid, return_to, {_M, _F, Arity} = Func, TS} = Trace, + Table, _, Dump) + when is_integer(Arity) -> + dump_stack(Dump, get(Pid), Trace), + trace_return_to(Table, Pid, Func, TS), + TS; +trace_handler({trace_ts, Pid, return_to, {_M, _F, Args} = MFArgs, TS} = Trace, + Table, _, Dump) + when is_list(Args) -> + dump_stack(Dump, get(Pid), Trace), + Func = mfarity(MFArgs), + trace_return_to(Table, Pid, Func, TS), + TS; +%% +%% spawn +trace_handler({trace_ts, Pid, spawn, Child, MFArgs, TS} = Trace, + Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_spawn(Table, Child, MFArgs, TS, Pid), + TS; +%% +%% exit +trace_handler({trace_ts, Pid, exit, _Reason, TS} = Trace, + Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_exit(Table, Pid, TS), + TS; +%% +%% out +trace_handler({trace_ts, Pid, out, 0, TS} = Trace, + Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_out(Table, Pid, undefined, TS), + TS; +trace_handler({trace_ts, Pid, out, {_M, _F, Arity} = Func, TS} = Trace, + Table, _, Dump) + when is_integer(Arity) -> + dump_stack(Dump, get(Pid), Trace), + trace_out(Table, Pid, Func, TS), + TS; +trace_handler({trace_ts, Pid, out, {_M, _F, Args} = MFArgs, TS} = Trace, + Table, _, Dump) + when is_list(Args) -> + dump_stack(Dump, get(Pid), Trace), + Func = mfarity(MFArgs), + trace_out(Table, Pid, Func, TS), + TS; +%% +%% in +trace_handler({trace_ts, Pid, in, 0, TS} = Trace, + Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_in(Table, Pid, undefined, TS), + TS; +trace_handler({trace_ts, Pid, in, {_M, _F, Arity} = Func, TS} = Trace, + Table, _, Dump) + when is_integer(Arity) -> + dump_stack(Dump, get(Pid), Trace), + trace_in(Table, Pid, Func, TS), + TS; +trace_handler({trace_ts, Pid, in, {_M, _F, Args} = MFArgs, TS} = Trace, + Table, _, Dump) + when is_list(Args) -> + dump_stack(Dump, get(Pid), Trace), + Func = mfarity(MFArgs), + trace_in(Table, Pid, Func, TS), + TS; +%% +%% gc_start +trace_handler({trace_ts, Pid, gc_start, _Func, TS} = Trace, + Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_gc_start(Table, Pid, TS), + TS; +%% +%% gc_end +trace_handler({trace_ts, Pid, gc_end, _Func, TS} = Trace, + Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_gc_end(Table, Pid, TS), + TS; +%% +%% link +trace_handler({trace_ts, Pid, link, _OtherPid, TS} = Trace, + _Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + TS; +%% +%% unlink +trace_handler({trace_ts, Pid, unlink, _OtherPid, TS} = Trace, + _Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + TS; +%% +%% getting_linked +trace_handler({trace_ts, Pid, getting_linked, _OtherPid, TS} = Trace, + _Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + TS; +%% +%% getting_unlinked +trace_handler({trace_ts, Pid, getting_unlinked, _OtherPid, TS} = Trace, + _Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + TS; +%% +%% register +trace_handler({trace_ts, Pid, register, _Name, TS} = Trace, + _Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + TS; +%% +%% unregister +trace_handler({trace_ts, Pid, unregister, _Name, TS} = Trace, + _Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + TS; +%% +%% send +trace_handler({trace_ts, Pid, send, _OtherPid, _Msg, TS} = Trace, + _Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + TS; +%% +%% 'receive' +trace_handler({trace_ts, Pid, 'receive', _Msg, TS} = Trace, + _Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + TS; +%% +%% Others +trace_handler(Trace, _Table, _, Dump) -> + dump(Dump, Trace), + throw({incorrect_trace_data, ?MODULE, ?LINE, [Trace]}). + + + +%% The call stack +%% -------------- +%% +%% The call stack can be modeled as a tree, with each level in the tree +%% corresponding to a real (non-tail recursive) stack entry, +%% and the nodes within a level corresponding to tail recursive +%% calls on that real stack depth. +%% +%% Example: +%% a() -> +%% b(). +%% b() -> +%% c(), +%% d(). +%% c() -> ok. +%% d() -> +%% e(), +%% c(). +%% e() -> +%% f(). +%% f() -> ok. +%% +%% During the execution the call tree would be, for each call and return_to: +%% +%% a() b() c() ->b d() e() f() ->d c() ->a +%% +%% a a a a a a a a a a +%% | | | |\ |\ |\ |\ /|\ +%% b b b b d b d b d b d b d c +%% | | /| +%% c e e f +%% +%% The call tree is in this code represented as a two level list, +%% which for the biggest tree (5 nodes) in the example above would be: +%% [[{f, _}, {e, _}], [{d, _}, {b, _}], [{a, _}]] +%% where the undefined fields are timestamps of the calls to the +%% functions, and the function name fields are really +%% {Module, Function, Arity} tuples. +%% +%% Since tail recursive calls can form an infinite loop, cycles +%% within a tail recursive level must be collapsed or else the +%% stack (tree) size may grow towards infinity. + + + +trace_call(Table, Pid, Func, TS, CP) -> + Stack = get_stack(Pid), + ?dbg(0, "trace_call(~p, ~p, ~p, ~p)~n~p~n", + [Pid, Func, TS, CP, Stack]), + {Proc,InitCnt} = + case ets:lookup(Table, Pid) of + [#proc{init_cnt = N} = P] -> + {P,N}; + [] -> + {undefined,0} + end, + case Stack of + [] -> + init_log(Table, Proc, Func), + OldStack = + if CP =:= undefined -> + Stack; + true -> + [[{CP, TS}]] + end, + put(Pid, trace_call_push(Table, Pid, Func, TS, OldStack)); + [[{Func, FirstInTS}]] when InitCnt=:=2 -> + %% First call on this process. Take the timestamp for first + %% time the process was scheduled in. + init_log(Table, Proc, Func), + OldStack = + if CP =:= undefined -> + []; + true -> + [[{CP, FirstInTS}]] + end, + put(Pid, trace_call_push(Table, Pid, Func, FirstInTS, OldStack)); + [[{suspend, _} | _] | _] -> + throw({inconsistent_trace_data, ?MODULE, ?LINE, + [Pid, Func, TS, CP, Stack]}); + [[{garbage_collect, _} | _] | _] -> + throw({inconsistent_trace_data, ?MODULE, ?LINE, + [Pid, Func, TS, CP, Stack]}); + [[{CP, _} | _], [{CP, _} | _] | _] -> + %% This is a difficult case - current function becomes + %% new stack top but is already pushed. It might be that + %% this call is actually tail recursive, or maybe not. + %% Assume tail recursive to not build the stack infinitely + %% and fix the problem at the next call after a return to + %% this level. + %% + %% This can be viewed as collapsing a very short stack + %% recursive stack cykle. + init_log(Table, Proc, Func), + put(Pid, trace_call_shove(Table, Pid, Func, TS, Stack)); + [[{CP, _} | _] | _] -> + %% Current function becomes new stack top -> stack push + init_log(Table, Proc, Func), + put(Pid, trace_call_push(Table, Pid, Func, TS, Stack)); + [_, [{CP, _} | _] | _] -> + %% Stack top unchanged -> no push == tail recursive call + init_log(Table, Proc, Func), + put(Pid, trace_call_shove(Table, Pid, Func, TS, Stack)); + [[{Func0, _} | _], [{Func0, _} | _], [{CP, _} | _] | _] -> + %% Artificial case that only should happen when + %% stack recursive short cycle collapsing has been done, + %% otherwise CP should not occur so far from the stack front. + %% + %% It is a tail recursive call but fix the stack first. + init_log(Table, Proc, Func), + put(Pid, + trace_call_shove(Table, Pid, Func, TS, + trace_return_to_int(Table, Pid, Func0, TS, + Stack))); + [[{_, TS0} | _] = Level0] -> + %% Current function known, but not stack top + %% -> assume tail recursive call + init_log(Table, Proc, Func), + OldStack = + if CP =:= undefined -> + Stack; + true -> + [Level0, [{CP, TS0}]] + end, + put(Pid, trace_call_shove(Table, Pid, Func, TS, OldStack)); + [_ | _] -> + %% Weird case when the stack is seriously f***ed up. + %% CP is not at stack top nor at previous stack top, + %% which is impossible, if we had a correct stack view. + OldStack = + if CP =:= undefined -> + %% Assume that CP is unknown because it is + %% the stack bottom for the process, and that + %% the whole call stack is invalid. Waste it. + trace_return_to_int(Table, Pid, CP, TS, Stack); + true -> + %% Assume that we have collapsed a tail recursive + %% call stack cykle too many. Introduce CP in + %% the current tail recursive level so it at least + %% gets charged for something. + init_log(Table, Proc, CP), + trace_call_shove(Table, Pid, CP, TS, Stack) + end, + %% Regard this call as a stack push. + init_log(Table, Pid, Func), % will lookup Pid in Table + put(Pid, trace_call_push(Table, Pid, Func, TS, OldStack)) + end, + ok. + +%% Normal stack push +trace_call_push(Table, Pid, Func, TS, Stack) -> + case Stack of + [] -> + ok; + [_ | _] -> + trace_clock(Table, Pid, TS, Stack, #clocks.own) + end, + NewStack = [[{Func, TS}] | Stack], + trace_clock(Table, Pid, 1, NewStack, #clocks.cnt), + NewStack. + +%% Tail recursive stack push +trace_call_shove(Table, Pid, Func, TS, Stack) -> + trace_clock(Table, Pid, TS, Stack, #clocks.own), + [[_ | NewLevel0] | NewStack1] = + case Stack of + [] -> + [[{Func, TS}]]; + [Level0 | Stack1] -> + [trace_call_collapse([{Func, TS} | Level0]) | Stack1] + end, + NewStack = [[{Func, TS} | NewLevel0] | NewStack1], + trace_clock(Table, Pid, 1, NewStack, #clocks.cnt), + NewStack. + +%% Collapse tail recursive call stack cycles to prevent them from +%% growing to infinite length. +trace_call_collapse([]) -> + []; +trace_call_collapse([_] = Stack) -> + Stack; +trace_call_collapse([_, _] = Stack) -> + Stack; +trace_call_collapse([_ | Stack1] = Stack) -> + trace_call_collapse_1(Stack, Stack1, 1). + +%% Find some other instance of the current function in the call stack +%% and try if that instance may be used as stack top instead. +trace_call_collapse_1(Stack, [], _) -> + Stack; +trace_call_collapse_1([{Func0, _} | _] = Stack, [{Func0, _} | S1] = S, N) -> + case trace_call_collapse_2(Stack, S, N) of + true -> + S; + false -> + trace_call_collapse_1(Stack, S1, N+1) + end; +trace_call_collapse_1(Stack, [_ | S1], N) -> + trace_call_collapse_1(Stack, S1, N+1). + +%% Check if all caller/called pairs in the perhaps to be collapsed +%% stack segment (at the front) are present in the rest of the stack, +%% and also in the same order. +trace_call_collapse_2(_, _, 0) -> + true; +trace_call_collapse_2([{Func1, _} | [{Func2, _} | _] = Stack2], + [{Func1, _} | [{Func2, _} | _] = S2], + N) -> + trace_call_collapse_2(Stack2, S2, N-1); +trace_call_collapse_2([{Func1, _} | _], [{Func1, _} | _], _N) -> + false; +trace_call_collapse_2(_Stack, [_], _N) -> + false; +trace_call_collapse_2(Stack, [_ | S], N) -> + trace_call_collapse_2(Stack, S, N); +trace_call_collapse_2(_Stack, [], _N) -> + false. + + + +trace_return_to(Table, Pid, Func, TS) -> + Stack = get_stack(Pid), + ?dbg(0, "trace_return_to(~p, ~p, ~p)~n~p~n", + [Pid, Func, TS, Stack]), + case Stack of + [[{suspend, _} | _] | _] -> + throw({inconsistent_trace_data, ?MODULE, ?LINE, + [Pid, Func, TS, Stack]}); + [[{garbage_collect, _} | _] | _] -> + throw({inconsistent_trace_data, ?MODULE, ?LINE, + [Pid, Func, TS, Stack]}); + [_ | _] -> + put(Pid, trace_return_to_int(Table, Pid, Func, TS, Stack)); + [] -> + put(Pid, trace_return_to_int(Table, Pid, Func, TS, Stack)) + end, + ok. + +trace_return_to_int(Table, Pid, Func, TS, Stack) -> + %% The old stack must be sent to trace_clock, so + %% the function we just returned from is charged with + %% own time. + trace_clock(Table, Pid, TS, Stack, #clocks.own), + case trace_return_to_2(Table, Pid, Func, TS, Stack) of + {undefined, _} -> + [[{Func, TS}] | Stack]; + {[[{Func, _} | Level0] | Stack1], _} -> + [[{Func, TS} | Level0] | Stack1]; + {NewStack, _} -> + NewStack + end. + +%% A list of charged functions is passed around to assure that +%% any function is charged with ACC time only once - the first time +%% it is encountered. The function trace_return_to_1 is called only +%% for the front of a tail recursive level, and if the front +%% does not match the returned-to function, trace_return_to_2 +%% is called for all functions within the tail recursive level. +%% +%% Charging is done in reverse order, i.e from stack rear to front. + +%% Search the call stack until the returned-to function is found at +%% a tail recursive level's front, and charge it with ACC time. +trace_return_to_1(_, _, undefined, _, []) -> + {[], []}; +trace_return_to_1(_, _, _, _, []) -> + {undefined, []}; +trace_return_to_1(Table, Pid, Func, TS, + [[{Func, _} | Level0] | Stack1] = Stack) -> + %% Match at front of tail recursive level + Charged = trace_return_to_3([Level0 | Stack1], []), + case lists:member(Func, Charged) of + false -> + trace_clock(Table, Pid, TS, Stack, #clocks.acc), + {Stack, [Func | Charged]}; + true -> + {Stack, Charged} + end; +trace_return_to_1(Table, Pid, Func, TS, Stack) -> + trace_return_to_2(Table, Pid, Func, TS, Stack). + +%% Charge all functions within one tail recursive level, +%% from rear to front, with ACC time. +trace_return_to_2(Table, Pid, Func, TS, [] = Stack) -> + trace_return_to_1(Table, Pid, Func, TS, Stack); +trace_return_to_2(Table, Pid, Func, TS, [[] | Stack1]) -> + trace_return_to_1(Table, Pid, Func, TS, Stack1); +trace_return_to_2(Table, Pid, Func, TS, + [[{Func0, _} | Level1] | Stack1] = Stack) -> + case trace_return_to_2(Table, Pid, Func, TS, [Level1 | Stack1]) of + {undefined, _} = R -> + R; + {NewStack, Charged} = R -> + case lists:member(Func0, Charged) of + false -> + trace_clock(Table, Pid, TS, Stack, #clocks.acc), + {NewStack, [Func0 | Charged]}; + true -> + R + end + end. + +%% Return a flat list of all function names in the given stack +trace_return_to_3([], R) -> + R; +trace_return_to_3([[] | Stack1], R) -> + trace_return_to_3(Stack1, R); +trace_return_to_3([[{Func0, _} | Level0] | Stack1], R) -> + trace_return_to_3([Level0 | Stack1], [Func0 | R]). + + + +trace_spawn(Table, Pid, MFArgs, TS, Parent) -> + Stack = get(Pid), + ?dbg(0, "trace_spawn(~p, ~p, ~p, ~p)~n~p~n", + [Pid, MFArgs, TS, Parent, Stack]), + case Stack of + undefined -> + {M,F,Args} = MFArgs, + OldStack = [[{{M,F,length(Args)},TS}]], + put(Pid, trace_call_push(Table, Pid, suspend, TS, OldStack)), + ets:insert(Table, #proc{id = Pid, parent = Parent, + spawned_as = MFArgs}); + _ -> + throw({inconsistent_trace_data, ?MODULE, ?LINE, + [Pid, MFArgs, TS, Parent, Stack]}) + end. + + + +trace_exit(Table, Pid, TS) -> + Stack = erase(Pid), + ?dbg(0, "trace_exit(~p, ~p)~n~p~n", [Pid, TS, Stack]), + case Stack of + undefined -> + ok; + [] -> + ok; + [_ | _] = Stack -> + trace_return_to_int(Table, Pid, undefined, TS, Stack), + ok + end, + ok. + + + +trace_out(Table, Pid, Func, TS) -> + Stack = get_stack(Pid), + ?dbg(0, "trace_out(~p, ~p, ~p)~n~p~n", [Pid, Func, TS, Stack]), + case Stack of + [] -> + put(Pid, trace_call_push(Table, Pid, suspend, TS, + case Func of + undefined -> []; + _ -> + [[{Func,TS}]] + end)); + [[{suspend,_}] | _] -> + %% No stats update for a suspend on suspend + put(Pid, [[{suspend,TS}] | Stack]); + [_ | _] -> + put(Pid, trace_call_push(Table, Pid, suspend, TS, Stack)) + end. + + + +trace_in(Table, Pid, Func, TS) -> + Stack = get(Pid), + ?dbg(0, "trace_in(~p, ~p, ~p)~n~p~n", [Pid, Func, TS, Stack]), + case Stack of + undefined -> + %% First activity on a process which existed at the time + %% the fprof trace was started. + put(Pid, [[{Func,TS}]]); + [] -> + put(Pid, [[{Func,TS}]]); + [[{suspend, _}]] -> + put(Pid, trace_return_to_int(Table, Pid, undefined, TS, Stack)); + [[{suspend,_}] | [[{suspend,_}] | _]=NewStack] -> + %% No stats update for a suspend on suspend + put(Pid, NewStack); + [[{suspend, _}] | [[{Func1, _} | _] | _]] -> + %% This is a new process (suspend and Func1 was inserted + %% by trace_spawn) or any process that has just been + %% scheduled out and now back in. + put(Pid, trace_return_to_int(Table, Pid, Func1, TS, Stack)); + _ -> + throw({inconsistent_trace_data, ?MODULE, ?LINE, + [Pid, Func, TS, Stack]}) + end. + + + +trace_gc_start(Table, Pid, TS) -> + Stack = get_stack(Pid), + ?dbg(0, "trace_gc_start(~p, ~p)~n~p~n", [Pid, TS, Stack]), + put(Pid, trace_call_push(Table, Pid, garbage_collect, TS, Stack)). + + + +trace_gc_end(Table, Pid, TS) -> + Stack = get(Pid), + ?dbg(0, "trace_gc_end(~p, ~p)~n~p~n", [Pid, TS, Stack]), + case Stack of + undefined -> + put(Pid, []); + [] -> + ok; + [[{garbage_collect, _}]] -> + put(Pid, trace_return_to_int(Table, Pid, undefined, TS, Stack)); + [[{garbage_collect, _}], [{Func1, _} | _] | _] -> + put(Pid, trace_return_to_int(Table, Pid, Func1, TS, Stack)); + _ -> + throw({inconsistent_trace_data, ?MODULE, ?LINE, + [Pid, TS, Stack]}) + end. + + + +%%%----------------------------------------- +%%% Statistics calculating support functions +%%%----------------------------------------- + + + +get_stack(Id) -> + case get(Id) of + undefined -> + []; + Stack -> + Stack + end. + + + +mfarity({M, F, Args}) when is_list(Args) -> + {M, F, length(Args)}; +mfarity(MFA) -> + MFA. + + + +init_log(_Table, _Proc, suspend) -> + ok; +init_log(_Table, _Proc, void) -> + ok; +init_log(_Table, undefined, _Entry) -> + ok; +init_log(_Table, #proc{init_cnt = 0}, _Entry) -> + ok; +init_log(Table, #proc{init_cnt = N, init_log = L} = Proc, Entry) -> + ets:insert(Table, Proc#proc{init_cnt = N-1, init_log = [Entry | L]}); +init_log(Table, Id, Entry) -> + Proc = + case ets:lookup(Table, Id) of + [P] -> P; + [] -> undefined + end, + init_log(Table,Proc,Entry). + + +trace_clock(_Table, _Pid, _T, + [[{suspend, _}], [{suspend, _}] | _]=_Stack, _Clock) -> + ?dbg(9, "trace_clock(Table, ~w, ~w, ~w, ~w)~n", + [_Pid, _T, _Stack, _Clock]), + void; +trace_clock(Table, Pid, T, + [[{garbage_collect, TS0}], [{suspend, _}]], Clock) -> + trace_clock_1(Table, Pid, T, TS0, undefined, garbage_collect, Clock); +trace_clock(Table, Pid, T, + [[{garbage_collect, TS0}], [{suspend, _}], [{Func2, _} | _] | _], + Clock) -> + trace_clock_1(Table, Pid, T, TS0, Func2, garbage_collect, Clock); +trace_clock(Table, Pid, T, [[{Func0, TS0}, {Func1, _} | _] | _], Clock) -> + trace_clock_1(Table, Pid, T, TS0, Func1, Func0, Clock); +trace_clock(Table, Pid, T, [[{Func0, TS0}], [{Func1, _} | _] | _], Clock) -> + trace_clock_1(Table, Pid, T, TS0, Func1, Func0, Clock); +trace_clock(Table, Pid, T, [[{Func0, TS0}]], Clock) -> + trace_clock_1(Table, Pid, T, TS0, undefined, Func0, Clock); +trace_clock(_, _, _, [], _) -> + void. + +trace_clock_1(Table, Pid, _, _, Caller, suspend, #clocks.own) -> + clock_add(Table, {Pid, Caller, suspend}, #clocks.own, 0); +trace_clock_1(Table, Pid, T, TS, Caller, Func, Clock) -> + clock_add(Table, {Pid, Caller, Func}, Clock, + if is_integer(T) -> + T; + true -> + ts_sub(T, TS) + end). + +clock_add(Table, Id, Clock, T) -> + ?dbg(1, "clock_add(Table, ~w, ~w, ~w)~n", [Id, Clock, T]), + try ets:update_counter(Table, Id, {Clock, T}) + catch + error:badarg -> + ets:insert(Table, #clocks{id = Id}), + X = ets:update_counter(Table, Id, {Clock, T}), + if X >= 0 -> ok; + true -> ?dbg(0, "Negative counter value ~p ~p ~p ~p~n", + [X, Id, Clock, T]) + end, + X + end. + +clocks_add(Table, #clocks{id = Id} = Clocks) -> + ?dbg(1, "clocks_add(Table, ~w)~n", [Clocks]), + case ets:lookup(Table, Id) of + [Clocks0] -> + ets:insert(Table, clocks_sum(Clocks, Clocks0, Id)); + [] -> + ets:insert(Table, Clocks) + end. + + + +clocks_sum(#clocks{id = _Id1, + cnt = Cnt1, + own = Own1, + acc = Acc1}, + #clocks{id = _Id2, + cnt = Cnt2, + own = Own2, + acc = Acc2}, + Id) -> + #clocks{id = Id, + cnt = Cnt1 + Cnt2, + own = Own1 + Own2, + acc = Acc1 + Acc2}. + + + +ts_sub({A, B, C} = _T, {A0, B0, C0} = _T0) -> + X = ((((A-A0)*1000000) + (B-B0))*1000000) + C - C0, + if X >= 0 -> ok; + true -> ?dbg(9, "Negative counter value ~p ~p ~p~n", + [X, _T, _T0]) + end, + X; +ts_sub(_, _) -> + undefined. + + + +%%%-------------------------------- +%%% Profile data analysis functions +%%%-------------------------------- + + + +do_analyse(Table, Analyse) -> + ?dbg(5, "do_analyse_1(~p, ~p)~n", [Table, Analyse]), + Result = + try do_analyse_1(Table, Analyse) + catch + Error -> Error + end, + ?dbg(5, "do_analyse_1(_, _) ->~p~n", [Result]), + Result. + +do_analyse_1(Table, + #analyse{group_leader = GroupLeader, + dest = Io, + cols = Cols0, + callers = PrintCallers, + sort = Sort, + totals = PrintTotals, + details = PrintDetails} = _Analyse) -> + Waste = 11, + MinCols = Waste + 12, %% We need Width >= 1 + Cols = if Cols0 < MinCols -> MinCols; true -> Cols0 end, + Width = (Cols-Waste) div 12, + FnameWidth = Cols - Waste - 5*Width, + Dest = {Io, [FnameWidth, Width, 2*Width, 2*Width]}, + SortElement = case Sort of + own -> + #clocks.own; + acc -> + #clocks.acc + end, + %% + %% Clean out the process dictionary before the next step + %% + _Erase = erase(), + ?dbg(2, "erase() -> ~p~n", [_Erase]), + %% + %% Process the collected data and spread it to 3 places: + %% * Per {process, caller, func}. Stored in the process dictionary. + %% * Sum per process. Stored in an ets table. + %% * Extra info per process. Stored in another ets table. + %% + io:format(GroupLeader, "Processing data...~n", []), + PidTable = ets:new(?MODULE, [set, private, {keypos, #clocks.id}]), + ProcTable = ets:new(?MODULE, [set, private, {keypos, #proc.id}]), + ets_select_foreach( + Table, [{'_', [], ['$_']}], 100, + fun (#clocks{id = {Pid, Caller, Func}} = Clocks) -> + case PrintDetails of + true -> + funcstat_pd(Pid, Caller, Func, Clocks), + clocks_add(PidTable, Clocks#clocks{id = Pid}); + false -> + ok + end, + clocks_add(PidTable, Clocks#clocks{id = totals}), + case PrintTotals of + true -> + funcstat_pd(totals, Caller, Func, Clocks); + false -> + ok + end; + (#proc{} = Proc) -> + ets:insert(ProcTable, Proc); + (#misc{} = Misc) -> + ets:insert(ProcTable, Misc) + end), + ?dbg(3, "get() -> ~p~n", [get()]), + {FirstTS, LastTS, _TraceCnt} = + case {ets:lookup(ProcTable, first_ts), + ets:lookup(ProcTable, last_ts_n)} of + {[#misc{data = FTS}], [#misc{data = {LTS, TC}}]} + when FTS =/= undefined, LTS =/= undefined -> + {FTS, LTS, TC}; + _ -> + throw({error,empty_trace}) + end, + Totals0 = + case ets:lookup(PidTable, totals) of + [T0] -> + ets:delete(PidTable, totals), + T0; + _ -> + throw({error,empty_trace}) + end, + Totals = Totals0#clocks{acc = ts_sub(LastTS, FirstTS)}, + ?dbg(3, "Totals0 = ~p~n", [Totals0]), + ?dbg(3, "PidTable = ~p~n", [ets:tab2list(PidTable)]), + ?dbg(3, "ProcTable = ~p~n", [ets:tab2list(ProcTable)]), + ?dbg(4, "Totals = ~p~n", [Totals]), + %% + %% Reorganize the process dictionary by Pid. + %% + lists:foreach( + fun ({{Pid, _Func}, Funcstat}) -> + put(Pid, [Funcstat | case get(Pid) of + undefined -> []; + Other -> Other + end]) + end, + erase()), + ?dbg(4, "get() -> ~p~n", [get()]), + %% + %% Sort the processes + %% + PidSorted = + postsort_r( + lists:sort( + ets:select(PidTable, + [{'_', [], [[{element, #clocks.own, '$_'} | '$_']]}]))), + ?dbg(4, "PidSorted = ~p~n", [PidSorted]), + %% + %% Print the functions per process + %% + io:format(GroupLeader, "Creating output...~n", []), + println(Dest, "%% ", [], "Analysis results:", ""), + println(Dest, "{ ", analysis_options, ",", ""), + println(Dest, " [{", {callers, PrintCallers}, "},", ""), + println(Dest, " {", {sort, Sort}, "},", ""), + println(Dest, " {", {totals, PrintTotals}, "},", ""), + println(Dest, " {", {details, PrintDetails}, "}]}.", ""), + println(Dest), + lists:foreach( + fun ({#clocks{} = Clocks, ProcOrPid, FuncstatList}) -> + println(Dest, "% ", head, "", ""), + case ProcOrPid of + #proc{} -> + println(Dest, "[{ ", Clocks, "},", "%%"), + print_proc(Dest, ProcOrPid); + totals -> + println(Dest, "[{ ", Clocks, "}].", "%%%"); + _ when is_pid(ProcOrPid) -> + println(Dest, "[{ ", Clocks, "}].", "%%") + end, + println(Dest), + lists:foreach( + fun (#funcstat{callers_sum = CallersSum, +% called_sum = CalledSum, + callers = Callers, + called = Called}) -> + case {PrintCallers, Callers} of +% {true, []} -> +% ok; + {true, _} -> + print_callers(Dest, Callers), + println(Dest, " { ", CallersSum, "},", "%"), + print_called(Dest, Called), + println(Dest); + {false, _} -> + println(Dest, "{ ", CallersSum, "}.", "") + end, + ok + end, + %% Sort the functions within the process, + %% and the callers and called within the function. + funcstat_sort_r(FuncstatList, SortElement)), + println(Dest) + end, + %% Look up the processes in sorted order + lists:map( + fun (#clocks{id = Pid} = Clocks) -> + Proc = case ets:lookup(ProcTable, Pid) of + [] -> Pid; + [ProcX] -> ProcX + end, + FuncstatList = + case get(Pid) of + undefined -> + []; + FL -> + FL + end, + {Clocks, Proc, FuncstatList} + end, + case PrintDetails of + true -> + [Totals | PidSorted]; + false -> + [Totals] + end)), + %% + %% Cleanup + %% + ets:delete(PidTable), + ets:delete(ProcTable), + io:format(GroupLeader, "Done!~n", []), + ok. + + + +%%---------------------------- +%% Analysis printout functions +%%---------------------------- + + + +print_proc({undefined, _}, _) -> + ok; +print_proc(Dest, + #proc{id = _Pid, + parent = Parent, + spawned_as = SpawnedAs, + init_log = InitLog}) -> + case {Parent, SpawnedAs, InitLog} of + {undefined, undefined, []} -> + println(Dest, " ", [], "].", ""); + {_, undefined, []} -> + println(Dest, " { ", {spawned_by, parsify(Parent)}, "}].", ""); + _ -> + println(Dest, " { ", {spawned_by, parsify(Parent)}, "},", ""), + case {SpawnedAs, InitLog} of + {_, []} -> + println(Dest, " { ", + {spawned_as, SpawnedAs}, + "}].", ""); + {undefined, _} -> + println(Dest, " { ", + {initial_calls, lists:reverse(InitLog)}, + "}].", ""); + _ -> + println(Dest, " { ", + {spawned_as, SpawnedAs}, + "},", ""), + println(Dest, " { ", + {initial_calls, lists:reverse(InitLog)}, + "}].", "") + end + end. + + + +print_callers(Dest, []) -> + println(Dest, "{[", [], "],", ""); +print_callers(Dest, [Clocks]) -> + println(Dest, "{[{", Clocks, "}],", ""); +print_callers(Dest, [Clocks | Tail]) -> + println(Dest, "{[{", Clocks, "},", ""), + print_callers_1(Dest, Tail). + +print_callers_1(Dest, [Clocks]) -> + println(Dest, " {", Clocks, "}],", ""); +print_callers_1(Dest, [Clocks | Tail]) -> + println(Dest, " {", Clocks, "},", ""), + print_callers_1(Dest, Tail). + + + +print_func(Dest, Clocks) -> + println(Dest, " { ", Clocks, "},", "%"). + + + +print_called(Dest, []) -> + println(Dest, " [", [], "]}.", ""); +print_called(Dest, [Clocks]) -> + println(Dest, " [{", Clocks, "}]}.", ""); +print_called(Dest, [Clocks | Tail]) -> + println(Dest, " [{", Clocks, "},", ""), + print_called_1(Dest, Tail). + +print_called_1(Dest, [Clocks]) -> + println(Dest, " {", Clocks, "}]}.", ""); +print_called_1(Dest, [Clocks | Tail]) -> + println(Dest, " {", Clocks, "},", ""), + print_called_1(Dest, Tail). + + + +println({undefined, _}) -> + ok; +println({Io, _}) -> + io:nl(Io). + +println({undefined, _}, _Head, + _, + _Tail, _Comment) -> + ok; +println({Io, [W1, W2, W3, W4]}, Head, + #clocks{id = Pid, cnt = Cnt, acc = _, own = Own}, + Tail, Comment) when is_pid(Pid) -> + io:put_chars(Io, + [pad(Head, $ , 3), + flat_format(parsify(Pid), $,, W1), + flat_format(Cnt, $,, W2, right), + flat_format(undefined, $,, W3, right), + flat_format(Own*0.001, [], W4-1, right), + pad(Tail, $ , 4), + pad($ , Comment, 4), + io_lib:nl()]); +println({Io, [W1, W2, W3, W4]}, Head, + #clocks{id = {_M, _F, _A} = Func, cnt = Cnt, acc = Acc, own = Own}, + Tail, Comment) -> + io:put_chars(Io, + [pad(Head, $ , 3), + flat_format(Func, $,, W1), + flat_format(Cnt, $,, W2, right), + flat_format(Acc*0.001, $,, W3, right), + flat_format(Own*0.001, [], W4-1, right), + pad(Tail, $ , 4), + pad($ , Comment, 4), + io_lib:nl()]); +println({Io, [W1, W2, W3, W4]}, Head, + #clocks{id = Id, cnt = Cnt, acc = Acc, own = Own}, + Tail, Comment) -> + io:put_chars(Io, + [pad(Head, $ , 3), + flat_format(parsify(Id), $,, W1), + flat_format(Cnt, $,, W2, right), + flat_format(Acc*0.001, $,, W3, right), + flat_format(Own*0.001, [], W4-1, right), + pad(Tail, $ , 4), + pad($ , Comment, 4), + io_lib:nl()]); +println({Io, [W1, W2, W3, W4]}, Head, + head, + Tail, Comment) -> + io:put_chars(Io, + [pad(Head, $ , 3), + pad(" ", $ , W1), + pad($ , " CNT ", W2), + pad($ , " ACC ", W3), + pad($ , " OWN", W4-1), + pad(Tail, $ , 4), + pad($ , Comment, 4), + io_lib:nl()]); +println({Io, _}, Head, + [], + Tail, Comment) -> + io:format(Io, "~s~s~s~n", + [pad(Head, $ , 3), Tail, Comment]); +println({Io, _}, Head, + {Tag, Term}, + Tail, Comment) -> + io:format(Io, "~s~p, ~p~s~s~n", + [pad(Head, $ , 3), parsify(Tag), parsify(Term), Tail, Comment]); +println({Io, _}, Head, + Term, + Tail, Comment) -> + io:format(Io, "~s~p~s~s~n", + [pad(Head, $ , 3), parsify(Term), Tail, Comment]). + + + +%%%-------------------------- +%%% Sorting support functions +%%%-------------------------- + + +%% Add a Clocks record to the callers and called funcstat records +%% in the process dictionary. +%% +funcstat_pd(Pid, Func1, Func0, Clocks) -> + put({Pid, Func0}, + case get({Pid, Func0}) of + undefined -> + #funcstat{callers_sum = Clocks#clocks{id = Func0}, + called_sum = #clocks{id = Func0}, + callers = [Clocks#clocks{id = Func1}]}; + #funcstat{callers_sum = CallersSum, + callers = Callers} = FuncstatCallers -> + FuncstatCallers#funcstat{ + callers_sum = clocks_sum(CallersSum, Clocks, Func0), + callers = [Clocks#clocks{id = Func1} | Callers]} + end), + put({Pid, Func1}, + case get({Pid, Func1}) of + undefined -> + #funcstat{callers_sum = #clocks{id = Func1}, + called_sum = Clocks#clocks{id = Func1}, + called = [Clocks#clocks{id = Func0}]}; + #funcstat{called_sum = CalledSum, + called = Called} = FuncstatCalled -> + FuncstatCalled#funcstat{ + called_sum = clocks_sum(CalledSum, Clocks, Func1), + called = [Clocks#clocks{id = Func0} | Called]} + end). + + + +%% Sort a list of funcstat records, +%% and sort the callers and called lists within the funcstat record. +funcstat_sort_r(FuncstatList, Element) -> + funcstat_sort_r_1(FuncstatList, Element, []). + +funcstat_sort_r_1([], _, R) -> + postsort_r(lists:sort(R)); +funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks, + callers = Callers, + called = Called} = Funcstat + | L], + Element, + R) -> + funcstat_sort_r_1(L, + Element, + [[element(Element, Clocks) + |Funcstat#funcstat{ + callers = clocks_sort_r(Callers, Element), + called = clocks_sort_r(Called, Element)}] + | R]). + + + +%% Sort a list of clocks records. +clocks_sort_r(L, E) -> + clocks_sort_r_1(L, E, []). + +clocks_sort_r_1([], _, R) -> + postsort_r(lists:sort(R)); +clocks_sort_r_1([#clocks{} = C | L], E, R) -> + clocks_sort_r_1(L, E, [[element(E, C)|C] | R]). + + +%% Take a list of terms with sort headers and strip the headers. +postsort_r(L) -> + postsort_r(L, []). + +postsort_r([], R) -> + R; +postsort_r([[_|C] | L], R) -> + postsort_r(L, [C | R]). + + + +%%%---------------------------------------------------------------------- +%%% Fairly generic support functions +%%% + +%% Standard format and flatten. +flat_format(F, Trailer) when is_float(F) -> + lists:flatten([io_lib:format("~.3f", [F]), Trailer]); +flat_format(W, Trailer) -> + lists:flatten([io_lib:format("~p", [W]), Trailer]). + +%% Format, flatten, and pad. +flat_format(Term, Trailer, Width) -> + flat_format(Term, Trailer, Width, left). + +flat_format(Term, Trailer, Width, left) -> + flat_format(Term, Trailer, Width, {left, $ }); +flat_format(Term, Trailer, Width, {left, Filler}) -> + pad(flat_format(Term, Trailer), Filler, Width); +flat_format(Term, Trailer, Width, right) -> + flat_format(Term, Trailer, Width, {right, $ }); +flat_format(Term, Trailer, Width, {right, Filler}) -> + pad(Filler, flat_format(Term, Trailer), Width). + + + +%% Left pad a string using a given char. +pad(Char, L, Size) when is_integer(Char), is_list(L), is_integer(Size) -> + List = lists:flatten(L), + Length = length(List), + if Length >= Size -> + List; + true -> + lists:append(lists:duplicate(Size - Length, Char), List) + end; +%% Right pad a string using a given char. +pad(L, Char, Size) when is_list(L), is_integer(Char), is_integer(Size) -> + List = lists:flatten(L), + Length = length(List), + if Length >= Size -> + List; + true -> + lists:append(List, lists:duplicate(Size - Length, Char)) + end. + + + +ets_select_foreach(Table, MatchSpec, Limit, Fun) -> + ets:safe_fixtable(Table, true), + ets_select_foreach_1(ets:select(Table, MatchSpec, Limit), Fun). + +ets_select_foreach_1('$end_of_table', _) -> + ok; +ets_select_foreach_1({Matches, Continuation}, Fun) -> + ?dbg(2, "Matches = ~p~n", [Matches]), + lists:foreach(Fun, Matches), + ets_select_foreach_1(ets:select(Continuation), Fun). + + + +%% Converts the parts of a deep term that are not parasable when printed +%% with io:format() into their string representation. +parsify([]) -> + []; +parsify([Hd | Tl]) -> + [parsify(Hd) | parsify(Tl)]; +parsify({A, B}) -> + {parsify(A), parsify(B)}; +parsify({A, B, C}) -> + {parsify(A), parsify(B), parsify(C)}; +parsify(Tuple) when is_tuple(Tuple) -> + list_to_tuple(parsify(tuple_to_list(Tuple))); +parsify(Pid) when is_pid(Pid) -> + erlang:pid_to_list(Pid); +parsify(Port) when is_port(Port) -> + erlang:port_to_list(Port); +parsify(Ref) when is_reference(Ref) -> + erlang:ref_to_list(Ref); +parsify(Fun) when is_function(Fun) -> + erlang:fun_to_list(Fun); +parsify(Term) -> + Term. + + + +%% A simple loop construct. +%% +%% Calls 'Fun' with argument 'Start' first and then repeatedly with +%% its returned value (state) until 'Fun' returns 'Stop'. Then +%% the last state value that was not 'Stop' is returned. + +% iterate(Start, Done, Fun) when is_function(Fun) -> +% iterate(Start, Done, Fun, Start). + +% iterate(Done, Done, Fun, I) -> +% I; +% iterate(I, Done, Fun, _) -> +% iterate(Fun(I), Done, Fun, I). diff --git a/lib/tools/src/instrument.erl b/lib/tools/src/instrument.erl new file mode 100644 index 0000000000..fa8a4a4867 --- /dev/null +++ b/lib/tools/src/instrument.erl @@ -0,0 +1,427 @@ +%% +%% %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(instrument). + +-export([holes/1, mem_limits/1, memory_data/0, read_memory_data/1, + sort/1, store_memory_data/1, sum_blocks/1, + descr/1, type_descr/2, allocator_descr/2, class_descr/2, + type_no_range/1, block_header_size/1, store_memory_status/1, + read_memory_status/1, memory_status/1]). + + +-define(OLD_INFO_SIZE, 32). %% (sizeof(mem_link) in pre R9C utils.c) + +-define(IHMARKER(H), element(1, H)). +-define(VSN(H), element(2, H)). +-define(INFO_SIZE(H), element(3, H)). +-define(TYPEMAP(H), element(4, H)). + +-define(IHDR(H), is_tuple(H), ?IHMARKER(H) =:= instr_hdr). +-define(IHDRVSN(H, V), ?IHDR(H), ?VSN(H) =:= V). + +memory_data() -> + case catch erlang:system_info(allocated) of + {'EXIT',{Error,_}} -> + erlang:error(Error, []); + {'EXIT',Error} -> + erlang:error(Error, []); + Res -> + Res + end. + +store_memory_data(File) -> + case catch erlang:system_info({allocated, File}) of + {'EXIT',{Error,_}} -> + erlang:error(Error, [File]); + {'EXIT',Error} -> + erlang:error(Error, [File]); + Res -> + Res + end. + +memory_status(Type) when is_atom(Type) -> + case catch erlang:system_info({allocated, status, Type}) of + {'EXIT',{Error,_}} -> + erlang:error(Error, [Type]); + {'EXIT',Error} -> + erlang:error(Error, [Type]); + Res -> + Res + end; +memory_status(Type) -> + erlang:error(badarg, [Type]). + +store_memory_status(File) when is_list(File) -> + case catch erlang:system_info({allocated, status, File}) of + {'EXIT',{Error,_}} -> + erlang:error(Error, [File]); + {'EXIT',Error} -> + erlang:error(Error, [File]); + Res -> + Res + end; +store_memory_status(File) -> + erlang:error(badarg, [File]). + +read_memory_data(File) when is_list(File) -> + case file:consult(File) of + {ok, [Hdr|MD]} when ?IHDR(Hdr) -> + {Hdr, MD}; + {ok, [{T,A,S,undefined}|_] = MD} when is_integer(T), + is_integer(A), + is_integer(S) -> + {{instr_hdr, 1, ?OLD_INFO_SIZE}, MD}; + {ok, [{T,A,S,{X,Y,Z}}|_] = MD} when is_integer(T), + is_integer(A), + is_integer(S), + is_integer(X), + is_integer(Y), + is_integer(Z) -> + {{instr_hdr, 1, ?OLD_INFO_SIZE}, MD}; + {ok, _} -> + {error, eio}; + Error -> + Error + end; +read_memory_data(File) -> + erlang:error(badarg, [File]). + +read_memory_status(File) when is_list(File) -> + case file:consult(File) of + {ok, [{instr_vsn, _}|Stat]} -> + Stat; + {ok, _} -> + {error, eio}; + Error -> + Error + end; +read_memory_status(File) -> + erlang:error(badarg, [File]). + +holes({Hdr, MD}) when ?IHDR(Hdr) -> + check_holes(?INFO_SIZE(Hdr), MD). + +check_holes(_ISz, []) -> + ok; +check_holes(ISz, [E | L]) -> + check_holes(ISz, E, L). + +check_holes(_ISz, _E1, []) -> + io:format("~n"); +check_holes(ISz, E1, [E2 | Rest]) -> + check_hole(ISz, E1, E2), + check_holes(ISz, E2, Rest). + +check_hole(ISz, {_,P1,S1,_}, {_,P2,_,_}) -> + End = P1+S1, + Hole = P2 - (End + ISz), + if + Hole =< 7 -> + ok; + true -> + io:format(" ~p", [Hole]) + end. + +sum_blocks({Hdr, L}) when ?IHDR(Hdr) -> + lists:foldl(fun({_,_,S,_}, Sum) -> S+Sum end, + 0, + L). + +mem_limits({Hdr, L}) when ?IHDR(Hdr) -> + {_, P1, _, _} = hd(L), + {_, P2, S2, _} = lists:last(L), + {P1, P2+S2}. + +sort({Hdr, MD}) when ?IHDR(Hdr) -> + {Hdr, lists:keysort(2, MD)}. + +descr({Hdr, MD} = ID) when ?IHDR(Hdr) -> + {Hdr, lists:map(fun ({TN, Addr, Sz, {0, N, S}}) -> + {type_descr(ID, TN), + Addr, + Sz, + list_to_pid("<0." + ++ integer_to_list(N) + ++ "." + ++ integer_to_list(S) + ++ ">")}; + ({TN, Addr, Sz, undefined}) -> + {type_descr(ID, TN), + Addr, + Sz, + undefined} + end, + MD)}. + +block_header_size({Hdr, _}) when ?IHDR(Hdr) -> + ?INFO_SIZE(Hdr). + +type_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), + is_integer(TypeNo) -> + case catch element(1, element(TypeNo, ?TYPEMAP(Hdr))) of + {'EXIT', _} -> invalid_type; + Type -> Type + end; +type_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), + is_integer(TypeNo) -> + type_string(TypeNo). + + +allocator_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), is_integer(TypeNo) -> + case catch element(2, element(TypeNo, ?TYPEMAP(Hdr))) of + {'EXIT', _} -> invalid_type; + Type -> Type + end; +allocator_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), is_integer(TypeNo) -> + "unknown". + +class_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), is_integer(TypeNo) -> + case catch element(3, element(TypeNo, ?TYPEMAP(Hdr))) of + {'EXIT', _} -> invalid_type; + Type -> Type + end; +class_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), is_integer(TypeNo) -> + "unknown". + +type_no_range({Hdr, _}) when ?IHDRVSN(Hdr, 2) -> + {1, tuple_size(?TYPEMAP(Hdr))}; +type_no_range({Hdr, _}) when ?IHDRVSN(Hdr, 1) -> + {-1, 1000}. + +type_string(-1) -> + "unknown"; +type_string(1) -> + "atom text"; +type_string(11) -> + "atom desc"; +type_string(2) -> + "bignum (big_to_list)"; +type_string(31) -> + "fixalloc"; +type_string(32) -> + "unknown fixalloc block"; +type_string(33) -> + "message buffer"; +type_string(34) -> + "message link"; +type_string(4) -> + "estack"; +type_string(40) -> + "db table vec"; +type_string(41) -> + "db tree select buffer"; +type_string(43) -> + "db hash select buffer"; +type_string(44) -> + "db hash select list"; +type_string(45) -> + "db match prog stack"; +type_string(46) -> + "db match prog heap data"; +type_string(47) -> + "db temp buffer"; +type_string(48) -> + "db error"; +type_string(49) -> + "db error info"; +type_string(50) -> + "db trans tab"; +type_string(51) -> + "db segment"; +type_string(52) -> + "db term"; +type_string(53) -> + "db add_counter"; +type_string(54) -> + "db segment table"; +type_string(55) -> + "db table (fix)"; +type_string(56) -> + "db bindings"; +type_string(57) -> + "db counter"; +type_string(58) -> + "db trace vec"; +type_string(59) -> + "db fixed deletion"; +type_string(60) -> + "binary (external.c)"; +type_string(61) -> + "binary"; +type_string(62) -> + "procbin (fix)"; +type_string(70) -> + "driver alloc (io.c)"; +type_string(71) -> + "binary (io.c)"; +type_string(72) -> + "binary vec (io.c)"; +type_string(73) -> + "binary vec 2 (io.c)"; +type_string(74) -> + "io vec (io.c)"; +type_string(75) -> + "io vec 2 (io.c)"; +type_string(76) -> + "temp io buffer (io.c)"; +type_string(77) -> + "temp io buffer 2 (io.c)"; +type_string(78) -> + "line buffer (io.c)"; +type_string(8) -> + "heap"; +type_string(801) -> + "heap (1)"; +type_string(802) -> + "heap (2)"; +type_string(803) -> + "heap (3)"; +type_string(804) -> + "heap (4)"; +type_string(805) -> + "heap (5)"; +type_string(821) -> + "heap fragment (1)"; +type_string(822) -> + "heap fragment (2)"; +type_string(830) -> + "sequential store buffer (for vectors)"; +type_string(91) -> + "process table"; +type_string(92) -> + "process desc"; +type_string(110) -> + "hash buckets"; +type_string(111) -> + "hash table"; +type_string(120) -> + "index init"; +type_string(121) -> + "index table"; +type_string(130) -> + "temp buffer"; +type_string(140) -> + "timer wheel"; +type_string(150) -> + "distribution cache"; +type_string(151) -> + "dmem"; +type_string(152) -> + "distribution table"; +type_string(153) -> + "distribution table buckets"; +type_string(154) -> + "distribution table entry"; +type_string(155) -> + "node table"; +type_string(156) -> + "node table buckets"; +type_string(157) -> + "node table entry"; +type_string(160) -> + "port table"; +type_string(161) -> + "driver entry"; +type_string(162) -> + "port setup"; +type_string(163) -> + "port wait"; +type_string(170) -> + "module"; +type_string(171) -> + "fundef"; +type_string(180) -> + "file table"; +type_string(181) -> + "driver table"; +type_string(182) -> + "poll struct"; +type_string(190) -> + "inet driver"; +type_string(200) -> + "efile driver"; +type_string(210) -> + "gc root set"; +type_string(220) -> + "breakpoint data"; +type_string(230) -> + "async queue"; +type_string(231) -> + "async (exit)"; +type_string(232) -> + "async (driver)"; +type_string(240) -> + "bits buffer"; +type_string(241) -> + "bits temp buffer"; +type_string(250) -> + "modules (loader)"; +type_string(251) -> + "code (loader)"; +type_string(252) -> + "atom tab (loader)"; +type_string(253) -> + "import tab (loader)"; +type_string(254) -> + "export tab (loader)"; +type_string(255) -> + "lable tab (loader)"; +type_string(256) -> + "gen op (loader)"; +type_string(257) -> + "gen op args (loader)"; +type_string(258) -> + "gen op args 2 (loader)"; +type_string(259) -> + "gen op args 3 (loader)"; +type_string(260) -> + "lambdas (loader)"; +type_string(261) -> + "temp int buffer (loader)"; +type_string(262) -> + "temp heap (loader)"; +type_string(280) -> + "dist ctrl msg buffer"; +type_string(281) -> + "dist_buf"; +type_string(290) -> + "call trace buffer"; +type_string(300) -> + "bif timer rec"; +type_string(310) -> + "argument registers"; +type_string(320) -> + "compressed binary temp buffer"; +type_string(330) -> + "term_to_binary temp buffer"; +type_string(340) -> + "proc dict"; +type_string(350) -> + "trace to port temp buffer"; +type_string(360) -> + "lists subtract temp buffer"; +type_string(370) -> + "link (lh)"; +type_string(380) -> + "port call buffer"; +type_string(400) -> + "definite_alloc block"; +type_string(_) -> + invalid_type. + diff --git a/lib/tools/src/make.erl b/lib/tools/src/make.erl new file mode 100644 index 0000000000..77c354651b --- /dev/null +++ b/lib/tools/src/make.erl @@ -0,0 +1,324 @@ +%% +%% %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 : Basic make facility + +%% Compares date stamps of .erl and Object files - recompiles when +%% necessary. +%% Files to be checked are contained in a file 'Emakefile' +%% If Emakefile is missing the current directory is used. +-module(make). + +-export([all/0,all/1,files/1,files/2]). + +-include_lib("kernel/include/file.hrl"). + +-define(MakeOpts,[noexec,load,netload,noload]). + +all() -> + all([]). + +all(Options) -> + {MakeOpts,CompileOpts} = sort_options(Options,[],[]), + case read_emakefile('Emakefile',CompileOpts) of + Files when is_list(Files) -> + do_make_files(Files,MakeOpts); + error -> + error + end. + +files(Fs) -> + files(Fs, []). + +files(Fs0, Options) -> + Fs = [filename:rootname(F,".erl") || F <- Fs0], + {MakeOpts,CompileOpts} = sort_options(Options,[],[]), + case get_opts_from_emakefile(Fs,'Emakefile',CompileOpts) of + Files when is_list(Files) -> + do_make_files(Files,MakeOpts); + error -> error + end. + +do_make_files(Fs, Opts) -> + process(Fs, lists:member(noexec, Opts), load_opt(Opts)). + + +sort_options([H|T],Make,Comp) -> + case lists:member(H,?MakeOpts) of + true -> + sort_options(T,[H|Make],Comp); + false -> + sort_options(T,Make,[H|Comp]) + end; +sort_options([],Make,Comp) -> + {Make,lists:reverse(Comp)}. + +%%% Reads the given Emakefile and returns a list of tuples: {Mods,Opts} +%%% Mods is a list of module names (strings) +%%% Opts is a list of options to be used when compiling Mods +%%% +%%% Emakefile can contain elements like this: +%%% Mod. +%%% {Mod,Opts}. +%%% Mod is a module name which might include '*' as wildcard +%%% or a list of such module names +%%% +%%% These elements are converted to [{ModList,OptList},...] +%%% ModList is a list of modulenames (strings) +read_emakefile(Emakefile,Opts) -> + case file:consult(Emakefile) of + {ok,Emake} -> + transform(Emake,Opts,[],[]); + {error,enoent} -> + %% No Emakefile found - return all modules in current + %% directory and the options given at command line + Mods = [filename:rootname(F) || F <- filelib:wildcard("*.erl")], + [{Mods, Opts}]; + {error,Other} -> + io:format("make: Trouble reading 'Emakefile':~n~p~n",[Other]), + error + end. + +transform([{Mod,ModOpts}|Emake],Opts,Files,Already) -> + case expand(Mod,Already) of + [] -> + transform(Emake,Opts,Files,Already); + Mods -> + transform(Emake,Opts,[{Mods,ModOpts++Opts}|Files],Mods++Already) + end; +transform([Mod|Emake],Opts,Files,Already) -> + case expand(Mod,Already) of + [] -> + transform(Emake,Opts,Files,Already); + Mods -> + transform(Emake,Opts,[{Mods,Opts}|Files],Mods++Already) + end; +transform([],_Opts,Files,_Already) -> + lists:reverse(Files). + +expand(Mod,Already) when is_atom(Mod) -> + expand(atom_to_list(Mod),Already); +expand(Mods,Already) when is_list(Mods), not is_integer(hd(Mods)) -> + lists:concat([expand(Mod,Already) || Mod <- Mods]); +expand(Mod,Already) -> + case lists:member($*,Mod) of + true -> + Fun = fun(F,Acc) -> + M = filename:rootname(F), + case lists:member(M,Already) of + true -> Acc; + false -> [M|Acc] + end + end, + lists:foldl(Fun, [], filelib:wildcard(Mod++".erl")); + false -> + Mod2 = filename:rootname(Mod, ".erl"), + case lists:member(Mod2,Already) of + true -> []; + false -> [Mod2] + end + end. + +%%% Reads the given Emakefile to see if there are any specific compile +%%% options given for the modules. +get_opts_from_emakefile(Mods,Emakefile,Opts) -> + case file:consult(Emakefile) of + {ok,Emake} -> + Modsandopts = transform(Emake,Opts,[],[]), + ModStrings = [coerce_2_list(M) || M <- Mods], + get_opts_from_emakefile2(Modsandopts,ModStrings,Opts,[]); + {error,enoent} -> + [{Mods, Opts}]; + {error,Other} -> + io:format("make: Trouble reading 'Emakefile':~n~p~n",[Other]), + error + end. + +get_opts_from_emakefile2([{MakefileMods,O}|Rest],Mods,Opts,Result) -> + case members(Mods,MakefileMods,[],Mods) of + {[],_} -> + get_opts_from_emakefile2(Rest,Mods,Opts,Result); + {I,RestOfMods} -> + get_opts_from_emakefile2(Rest,RestOfMods,Opts,[{I,O}|Result]) + end; +get_opts_from_emakefile2([],[],_Opts,Result) -> + Result; +get_opts_from_emakefile2([],RestOfMods,Opts,Result) -> + [{RestOfMods,Opts}|Result]. + +members([H|T],MakefileMods,I,Rest) -> + case lists:member(H,MakefileMods) of + true -> + members(T,MakefileMods,[H|I],lists:delete(H,Rest)); + false -> + members(T,MakefileMods,I,Rest) + end; +members([],_MakefileMods,I,Rest) -> + {I,Rest}. + + +%% Any flags that are not recognixed as make flags are passed directly +%% to the compiler. +%% So for example make:all([load,debug_info]) will make everything +%% with the debug_info flag and load it. + +load_opt(Opts) -> + case lists:member(netload,Opts) of + true -> + netload; + false -> + case lists:member(load,Opts) of + true -> + load; + _ -> + noload + end + end. + + +process([{[],_Opts}|Rest], NoExec, Load) -> + process(Rest, NoExec, Load); +process([{[H|T],Opts}|Rest], NoExec, Load) -> + case recompilep(coerce_2_list(H), NoExec, Load, Opts) of + error -> + error; + _ -> + process([{T,Opts}|Rest], NoExec, Load) + end; +process([], _NoExec, _Load) -> + up_to_date. + +recompilep(File, NoExec, Load, Opts) -> + ObjName = lists:append(filename:basename(File), + code:objfile_extension()), + ObjFile = case lists:keysearch(outdir,1,Opts) of + {value,{outdir,OutDir}} -> + filename:join(coerce_2_list(OutDir),ObjName); + false -> + ObjName + end, + case exists(ObjFile) of + true -> + recompilep1(File, NoExec, Load, Opts, ObjFile); + false -> + recompile(File, NoExec, Load, Opts) + end. + +recompilep1(File, NoExec, Load, Opts, ObjFile) -> + {ok, Erl} = file:read_file_info(lists:append(File, ".erl")), + {ok, Obj} = file:read_file_info(ObjFile), + case {readable(Erl), writable(Obj)} of + {true, true} -> + recompilep1(Erl, Obj, File, NoExec, Load, Opts); + _ -> + error + end. + +recompilep1(#file_info{mtime=Te}, + #file_info{mtime=To}, File, NoExec, Load, Opts) when Te>To -> + recompile(File, NoExec, Load, Opts); +recompilep1(_Erl, #file_info{mtime=To}, File, NoExec, Load, Opts) -> + recompile2(To, File, NoExec, Load, Opts). + +%% recompile2(ObjMTime, File, NoExec, Load, Opts) +%% Check if file is of a later date than include files. +recompile2(ObjMTime, File, NoExec, Load, Opts) -> + IncludePath = include_opt(Opts), + case check_includes(lists:append(File, ".erl"), IncludePath, ObjMTime) of + true -> + recompile(File, NoExec, Load, Opts); + false -> + false + end. + +include_opt([{i,Path}|Rest]) -> + [Path|include_opt(Rest)]; +include_opt([_First|Rest]) -> + include_opt(Rest); +include_opt([]) -> + []. + +%% recompile(File, NoExec, Load, Opts) +%% Actually recompile and load the file, depending on the flags. +%% Where load can be netload | load | noload + +recompile(File, true, _Load, _Opts) -> + io:format("Out of date: ~s\n",[File]); +recompile(File, false, noload, Opts) -> + io:format("Recompile: ~s\n",[File]), + compile:file(File, [report_errors, report_warnings, error_summary |Opts]); +recompile(File, false, load, Opts) -> + io:format("Recompile: ~s\n",[File]), + c:c(File, Opts); +recompile(File, false, netload, Opts) -> + io:format("Recompile: ~s\n",[File]), + c:nc(File, Opts). + +exists(File) -> + case file:read_file_info(File) of + {ok, _} -> + true; + _ -> + false + end. + +readable(#file_info{access=read_write}) -> true; +readable(#file_info{access=read}) -> true; +readable(_) -> false. + +writable(#file_info{access=read_write}) -> true; +writable(#file_info{access=write}) -> true; +writable(_) -> false. + +coerce_2_list(X) when is_atom(X) -> + atom_to_list(X); +coerce_2_list(X) -> + X. + +%%% If you an include file is found with a modification +%%% time larger than the modification time of the object +%%% file, return true. Otherwise return false. +check_includes(File, IncludePath, ObjMTime) -> + Path = [filename:dirname(File)|IncludePath], + case epp:open(File, Path, []) of + {ok, Epp} -> + check_includes2(Epp, File, ObjMTime); + _Error -> + false + end. + +check_includes2(Epp, File, ObjMTime) -> + case epp:parse_erl_form(Epp) of + {ok, {attribute, 1, file, {File, 1}}} -> + check_includes2(Epp, File, ObjMTime); + {ok, {attribute, 1, file, {IncFile, 1}}} -> + case file:read_file_info(IncFile) of + {ok, #file_info{mtime=MTime}} when MTime>ObjMTime -> + epp:close(Epp), + true; + _ -> + check_includes2(Epp, File, ObjMTime) + end; + {ok, _} -> + check_includes2(Epp, File, ObjMTime); + {eof, _} -> + epp:close(Epp), + false; + {error, _Error} -> + check_includes2(Epp, File, ObjMTime) + end. diff --git a/lib/tools/src/tags.erl b/lib/tools/src/tags.erl new file mode 100644 index 0000000000..e740d38c91 --- /dev/null +++ b/lib/tools/src/tags.erl @@ -0,0 +1,344 @@ +%% +%% %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 : tags.erl +%%% Author : Anders Lindgren +%%% Purpose : Generate an Emacs TAGS file from programs written in Erlang. +%%% Date : 1998-03-16 +%%% Version : 1.1 +%%%---------------------------------------------------------------------- + +-module(tags). + +-export([file/1, file/2, files/1, files/2, dir/1, dir/2, + dirs/1, dirs/2, subdir/1, subdir/2, subdirs/1, subdirs/2, + root/0, root/1]). + + +%% `Tags' is a part of the editor Emacs. It is used for warp-speed +%% jumps between different source files in a project. When Using +%% `Tags', a function in any source file can be found by few a simple +%% keystrokes, just press M-. (in normal terms: Press Escape and dot). +%% +%% In order to work, the `Tags' system needs a list of all functions +%% in all source files in the project. This list is denoted the "TAGS +%% file". This purpose of this module is to create the TAGS file for +%% programs written in Erlang. +%% +%% In addition to functions, both records and macros (`define's) are +%% added to the TAGS file. + + +%% Usage: +%% root([Options]) -- Create a TAGS file covering all files in +%% the Erlang distribution. +%% +%% file(File [, Options]) -- Create a TAGS file for the file `File'. +%% files(FileList [, Options]) +%% -- Dito for all files in `FileList'. +%% +%% dir(Dir [, Options]) -- Create a TAGS file for all files in `Dir'. +%% dirs(DirList [, Options]) -- Dito for all files in all +%% directories in `DirList'. +%% +%% subdir(Dir [, Options]) -- Descend recursively down `Dir' and create +%% a TAGS file convering all files found. +%% subdirs(DirList [, Options]) +%% -- Dito, for all directories in `DirList'. +%% +%% The default is to create a file named "TAGS" in the current directory. +%% +%% Options is a list of tuples, where the following tuples are +%% recognised: +%% {outfile, NameOfTAGSFile} +%% {outdir, NameOfDirectory} +%% +%% Note, should both `outfile' and `outdir' options be given, `outfile' +%% take precedence. + + +%%% External interface + +root() -> root([]). +root(Options) -> subdir(code:root_dir(), Options). + +dir(Dir) -> dir(Dir, []). +dir(Dir, Options) -> dirs([Dir], Options). + +dirs(Dirs) -> dirs(Dirs, []). +dirs(Dirs, Options) -> + files(collect_dirs(Dirs, false), Options). + +subdir(Dir) -> subdir(Dir, []). +subdir(Dir, Options) -> subdirs([Dir], Options). + +subdirs(Dirs) -> subdirs(Dirs, []). +subdirs(Dirs, Options) -> + files(collect_dirs(Dirs, true), Options). + +file(Name) -> file(Name, []). +file(Name, Options) -> files([Name], Options). + +files(Files) -> files(Files, []). +files(Files, Options) -> + case open_out(Options) of + {ok, Os} -> + files_loop(Files, Os), + close_out(Os), + ok; + _ -> + error + end. + + + +%%% Internal functions. + +%% Find all files in a directory list. Should the second argument be +%% the atom `true' the functions will descend into subdirectories. +collect_dirs(Dirs, Recursive) -> + collect_dirs(Dirs, Recursive, []). + +collect_dirs([], _Recursive, Acc) -> Acc; +collect_dirs([Dir | Dirs], Recursive, Acc) -> + NewAcc = case file:list_dir(Dir) of + {ok, Entries} -> + collect_files(Dir, Entries, Recursive, Acc); + _ -> + Acc + end, + collect_dirs(Dirs, Recursive, NewAcc). + +collect_files(_Dir,[],_Recursive, Acc) -> Acc; +collect_files(Dir, [File | Files], Recursive, Acc) -> + FullFile = filename:join(Dir, File), + NewAcc = case filelib:is_dir(FullFile) of + true when Recursive -> + collect_dirs([FullFile], Recursive, Acc); + true -> + Acc; + false -> + case filelib:is_regular(FullFile) of + true -> + case filename:extension(File) of + ".erl" -> + [FullFile | Acc]; + ".hrl" -> + [FullFile | Acc]; + _ -> + Acc + end; + false -> + Acc + end + end, + collect_files(Dir, Files, Recursive, NewAcc). + + +files_loop([],_Os) -> true; +files_loop([F | Fs], Os) -> + case filename(F, Os) of + ok -> + ok; + error -> + %% io:format("Could not open ~s~n", [F]), + error + end, + files_loop(Fs, Os). + + +%% Generate tags for one file. +filename(Name, Os) -> + case file:open(Name, [read]) of + {ok, Desc} -> + Acc = module(Desc, [], [], {1, 0}), + file:close(Desc), + genout(Os, Name, Acc), + ok; + _ -> + error + end. + + +module(In, Last, Acc, {LineNo, CharNo}) -> + case io:get_line(In, []) of + eof -> + Acc; + Line -> + {NewLast, NewAcc} = line(Line, Last, Acc, {LineNo, CharNo}), + module(In, NewLast, NewAcc, {LineNo+1, CharNo+length(Line)}) + end. + + +%% Handle one line. Return the last added function name. +line([], Last, Acc, _) -> {Last, Acc}; +line(Line, _, Acc, Nos) when hd(Line) =:= $- -> + case attribute(Line, Nos) of + false -> {[], Acc}; + New -> {[], [New | Acc]} + end; +line(Line, Last, Acc, Nos) -> + %% to be OR not to be? + case case {hd(Line), word_char(hd(Line))} of + {$', _} -> true; + {_, true} -> true; + _ -> false + end of + true -> + case func(Line, Last, Nos) of + false -> + {Last, Acc}; + {NewLast, NewEntry} -> + {NewLast, [NewEntry | Acc]} + end; + false -> + {Last, Acc} + end. + +%% Handle one function. Will only add the first clause. (i.e. +%% if the function name doesn't match `Last'). +%% Return `false' or {NewLast, GeneratedLine}. +func(Line, Last, Nos) -> + {Name, Line1} = word(Line), + case Name of + [] -> false; + Last -> false; + _ -> + {Space, Line2} = white(Line1), + case Line2 of + [$( | _] -> + {Name, pfnote([$(, Space, Name], Nos)}; + _ -> + false + end + end. + + +%% Return `false' or generated line. +attribute([$- | Line], Nos) -> + {Attr, Line1} = word(Line), + case case Attr of + "drocer" -> true; + "enifed" -> true; + _ -> false + end of + false -> + false; + true -> + {Space2, Line2} = white(Line1), + case Line2 of + [$( | Line3] -> + {Space4, Line4} = white(Line3), + {Name,_Line5} = word(Line4), + case Name of + [] -> false; + _ -> + pfnote([Name, Space4, $(, Space2, Attr, $-], Nos) + end; + _ -> + false + end + end. + + +%% Removes whitespace from the head of the line. +%% Returns {ReveredSpace, Rest} +white(Line) -> white(Line, []). + +white([], Acc) -> {Acc, []}; +white([32 | Rest], Acc) -> white(Rest, [32 | Acc]); +white([9 | Rest], Acc) -> white(Rest, [9 | Acc]); +white(Line, Acc) -> {Acc, Line}. + + +%% Returns {ReversedWord, Rest} +word([$' | Rest]) -> + quoted(Rest, [$']); +word(Line) -> + unquoted(Line, []). + +quoted([$' | Rest], Acc) -> {[$' | Acc], Rest}; +quoted([$\\ , C | Rest], Acc) -> + quoted(Rest, [C, $\\ | Acc]); +quoted([C | Rest], Acc) -> + quoted(Rest, [C | Acc]). + +unquoted([], Word) -> {Word, []}; +unquoted([C | Cs], Acc) -> + case word_char(C) of + true -> unquoted(Cs, [C | Acc]); + false -> {Acc, [C | Cs]} + end. + +word_char(C) when C >= $a, C =< $z -> true; +word_char(C) when C >= $A, C =< $Z -> true; +word_char(C) when C >= $0, C =< $9 -> true; +word_char($_) -> true; +word_char(_) -> false. + + +%%% Output routines + +%% Check the options `outfile' and `outdir'. +open_out(Options) -> + case lists:keysearch(outfile, 1, Options) of + {value, {outfile, File}} -> + file:open(File, [write]); + _ -> + case lists:keysearch(outdir, 1, Options) of + {value, {outdir, Dir}} -> + file:open(filename:join(Dir, "TAGS"), [write]); + _ -> + file:open("TAGS", [write]) + end + end. + + +close_out(Os) -> + file:close(Os). + + +pfnote(Str, {LineNo, CharNo}) -> + io_lib:format("~s\177~w,~w~n", [flatrev(Str), LineNo, CharNo]). + + +genout(Os, Name, Entries) -> + io:format(Os, "\^l~n~s,~w~n", [Name, reclength(Entries)]), + io:put_chars(Os, lists:reverse(Entries)). + + + +%%% help routines + +%% Flatten and reverse a nested list. +flatrev(Ls) -> flatrev(Ls, []). + +flatrev([C | Ls], Acc) when is_integer(C) -> flatrev(Ls, [C | Acc]); +flatrev([L | Ls], Acc) -> flatrev(Ls, flatrev(L, Acc)); +flatrev([], Acc) -> Acc. + + +%% Count the number of elements in a nested list. +reclength([L | Ls]) when is_list(L) -> + reclength(L) + reclength(Ls); +reclength([_ | Ls]) -> + reclength(Ls) + 1; +reclength([]) -> 0. + +%%% tags.erl ends here. diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src new file mode 100644 index 0000000000..cd9b622f15 --- /dev/null +++ b/lib/tools/src/tools.app.src @@ -0,0 +1,60 @@ +%% +%% %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% +%% +{application, tools, + [{description, "DEVTOOLS CXC 138 16"}, + {vsn, "%VSN%"}, + {modules, [cover, + cover_web, + eprof, + fprof, + instrument, + make, + xref, + xref_base, + xref_compiler, + xref_parser, + xref_reader, + xref_scanner, + xref_utils + ] + }, + {registered,[webcover_server]}, + {applications, [kernel, stdlib]}, + {env, [{file_util_search_methods,[{"", ""}, {"ebin", "esrc"}, {"ebin", "src"}]} + ] + } + ] +}. + + + + + + + + + + + + + + + + + diff --git a/lib/tools/src/tools.appup.src b/lib/tools/src/tools.appup.src new file mode 100644 index 0000000000..8de1ec76c9 --- /dev/null +++ b/lib/tools/src/tools.appup.src @@ -0,0 +1,19 @@ +# +# %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% +# +{"%VSN%",[],[]}. diff --git a/lib/tools/src/xref.erl b/lib/tools/src/xref.erl new file mode 100644 index 0000000000..0693bec019 --- /dev/null +++ b/lib/tools/src/xref.erl @@ -0,0 +1,607 @@ +%% +%% %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(xref). + +-behaviour(gen_server). + +%% External exports +-export([start/1, start/2, stop/1]). + +-export([m/1, d/1, + add_release/2, add_release/3, + add_application/2, add_application/3, + add_module/2, add_module/3, + add_directory/2, add_directory/3, + replace_module/3, replace_module/4, + replace_application/3, replace_application/4, + remove_module/2, remove_application/2, remove_release/2, + get_library_path/1, set_library_path/2, set_library_path/3, + q/2, q/3, info/1, info/2, info/3, + update/1, update/2, + forget/1, forget/2, variables/1, variables/2, + analyze/2, analyze/3, analyse/2, analyse/3, + get_default/1, get_default/2, + set_default/2, set_default/3]). + +-export([format_error/1]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-import(lists, [keydelete/3, keysearch/3]). + +-import(sofs, [to_external/1, is_sofs_set/1]). + +%%%---------------------------------------------------------------------- +%%% API +%%%---------------------------------------------------------------------- + +%% add_release(Servername, Directory) -> +%% {ok, ReleaseName} | Error +%% add_release(Servername, Directory, Options) -> +%% {ok, ReleaseName} | Error +%% add_application(Servername, Directory) -> +%% {ok, AppName} | Error +%% add_application(Servername, Directory, Options) -> +%% {ok, AppName} | Error +%% add_module(ServerName, Filename) -> +%% {ok, ModuleName} | Error +%% add_module(ServerName, Filename, Options) -> +%% {ok, ModuleName} | Error +%% add_directory(ServerName, Directory) -> +%% {ok, [ModuleName]} | Error +%% add_directory(ServerName, Directory, Options) -> +%% {ok, [ModuleName]} | Error +%% replace_module(ServerName, Module, Filename) -> +%% {ok, Module} | Error +%% replace_module(ServerName, Module, Filename, Options) -> +%% {ok, Module} | Error +%% replace_application(ServerName, Application, Directory) -> +%% {ok, AppName} | Error +%% replace_application(ServerName, Application, Directory, Options) -> +%% {ok, AppName} | Error +%% remove_module(ServerName, Module) -> ok | Error +%% remove_application(ServerName, Application) -> ok | Error +%% remove_release(ServerName, Release) -> ok | Error +%% get_library_path(Servername) -> {ok, Path} +%% set_library_path(Servername, Path) -> ok | Error +%% set_library_path(Servername, Path, Options) -> ok | Error +%% info(Servername) -> InfoList +%% info(Servername, What) -> [{what(), InfoList}] | Error +%% info(Servername, What, Qual) -> [{what(), InfoList}] | Error +%% update(Servername) -> {ok, [Module]} | Error +%% update(Servername, Options) -> {ok, [Module]} | Error +%% forget(Servername) -> ok +%% forget(Servername, VariableName) -> ok | Error +%% variables(Servername) -> {ok, [{VarType, [VariableName]}]} | Error +%% variables(Servername, [VarType]) -> {ok, [{VarType, [VariableName]}]} +%% analyze(ServerName, What) -> {ok, Answer} | Error +%% analyze(ServerName, What, Options) -> {ok, Answer} | Error +%% q(Servername, Query) -> {ok, Answer} | Error +%% q(Servername, Query, Options) -> {ok, Answer} | Error +%% get_default(ServerName, Option) -> {ok, Value} | Error +%% set_default(ServerName, Option, Value) -> {ok, OldValue} | Error +%% get_default(ServerName) -> [{Option, Value}] +%% set_default(ServerName, [{Option, Value}]) -> ok | Error +%% format_error(Error) -> io_string() +%% m(Module) -> [Result] | Error +%% m(File) -> [Result] | Error +%% d(Directory) -> [Result] | Error + +%% -> [Faulty] | Error; Faulty = {undefined, Calls} | {unused, Funs} +%% No user variables have been assigned digraphs, so there is no +%% need to call xref_base:delete/1. +m(Module) when is_atom(Module) -> + case xref_utils:find_beam(Module) of + {ok, File} -> + Fun = fun(S) -> + xref_base:add_module(S, File, {builtins,true}) + end, + case catch do_functions_analysis(Fun) of + {error, _, {no_debug_info, _}} -> + catch do_modules_analysis(Fun); + Result -> + Result + end; + Error -> Error + end; +m(File) -> + case xref_utils:split_filename(File, ".beam") of + false -> + {error, xref_base, {invalid_filename, File}}; + {Dir, BaseName} -> + BeamFile = filename:join(Dir, BaseName), + Fun = fun(S) -> + xref_base:add_module(S, BeamFile, {builtins, true}) + end, + case catch do_functions_analysis(Fun) of + {error, _, {no_debug_info, _}} -> + catch do_modules_analysis(Fun); + Result -> + Result + end + end. + +%% -> [Faulty] | Error; Faulty = {undefined, Calls} | {unused, Funs} +d(Directory) -> + Fun = fun(S) -> + xref_base:add_directory(S, Directory, {builtins, true}) + end, + Fun1 = fun(S) -> + case Fun(S) of + {ok, [], _S} -> + no_modules; + Reply -> + Reply + end + end, + case catch do_functions_analysis(Fun1) of + no_modules -> + catch do_modules_analysis(Fun); + Result -> + Result + end. + +start(Name) when is_atom(Name) -> + start(Name, []); +start(Opts0) when is_list(Opts0) -> + {Args, Opts} = split_args(Opts0), + gen_server:start(xref, Args, Opts). + +start(Name, Opts0) when is_list(Opts0) -> + {Args, Opts} = split_args(Opts0), + gen_server:start({local, Name}, xref, Args, Opts); +start(Name, Opt) -> + start(Name, [Opt]). + +split_args(Opts) -> + case keysearch(xref_mode, 1, Opts) of + {value, Mode} -> + {[Mode], keydelete(xref_mode, 1, Opts)}; + false -> + {[], Opts} + end. + +stop(Name) -> + gen_server:call(Name, stop, infinity). + +add_release(Name, Dir) -> + gen_server:call(Name, {add_release, Dir}, infinity). + +add_release(Name, Dir, Options) -> + gen_server:call(Name, {add_release, Dir, Options}, infinity). + +add_application(Name, Dir) -> + gen_server:call(Name, {add_application, Dir}, infinity). + +add_application(Name, Dir, Options) -> + gen_server:call(Name, {add_application, Dir, Options}, infinity). + +add_module(Name, File) -> + gen_server:call(Name, {add_module, File}, infinity). + +add_module(Name, File, Options) -> + gen_server:call(Name, {add_module, File, Options}, infinity). + +add_directory(Name, Dir) -> + gen_server:call(Name, {add_directory, Dir}, infinity). + +add_directory(Name, Dir, Options) -> + gen_server:call(Name, {add_directory, Dir, Options}, infinity). + +replace_module(Name, Module, File) -> + gen_server:call(Name, {replace_module, Module, File}, infinity). + +replace_module(Name, Module, File, Options) -> + gen_server:call(Name, {replace_module, Module, File, Options}, infinity). + +replace_application(Name, App, Dir) -> + gen_server:call(Name, {replace_application, App, Dir}, infinity). + +replace_application(Name, App, Dir, Options) -> + gen_server:call(Name, {replace_application, App, Dir, Options}, infinity). + +remove_module(Name, Mod) -> + gen_server:call(Name, {remove_module, Mod}, infinity). + +remove_application(Name, App) -> + gen_server:call(Name, {remove_application, App}, infinity). + +remove_release(Name, Rel) -> + gen_server:call(Name, {remove_release, Rel}, infinity). + +get_library_path(Name) -> + gen_server:call(Name, get_library_path, infinity). + +set_library_path(Name, Path) -> + gen_server:call(Name, {set_library_path, Path}, infinity). + +set_library_path(Name, Path, Options) -> + gen_server:call(Name, {set_library_path, Path, Options}, infinity). + +info(Name) -> + gen_server:call(Name, info, infinity). + +info(Name, What) -> + gen_server:call(Name, {info, What}, infinity). + +info(Name, What, Qual) -> + gen_server:call(Name, {info, What, Qual}, infinity). + +update(Name) -> + gen_server:call(Name, update, infinity). + +update(Name, Options) -> + gen_server:call(Name, {update, Options}, infinity). + +forget(Name) -> + gen_server:call(Name, forget, infinity). + +forget(Name, Variable) -> + gen_server:call(Name, {forget, Variable}, infinity). + +variables(Name) -> + gen_server:call(Name, variables, infinity). + +variables(Name, Options) -> + gen_server:call(Name, {variables, Options}, infinity). + +analyse(Name, What) -> + gen_server:call(Name, {analyze, What}, infinity). + +analyse(Name, What, Options) -> + gen_server:call(Name, {analyze, What, Options}, infinity). + +analyze(Name, What) -> + gen_server:call(Name, {analyze, What}, infinity). + +analyze(Name, What, Options) -> + gen_server:call(Name, {analyze, What, Options}, infinity). + +q(Name, Q) -> + gen_server:call(Name, {qry, Q}, infinity). + +q(Name, Q, Options) -> + gen_server:call(Name, {qry, Q, Options}, infinity). + +get_default(Name) -> + gen_server:call(Name, get_default, infinity). + +get_default(Name, Option) -> + gen_server:call(Name, {get_default, Option}, infinity). + +set_default(Name, OptionValues) -> + gen_server:call(Name, {set_default, OptionValues}, infinity). + +set_default(Name, Option, Value) -> + gen_server:call(Name, {set_default, Option, Value}, infinity). + +format_error({error, Module, Error}) -> + Module:format_error(Error); +format_error(E) -> + io_lib:format("~p~n", [E]). + +%%%---------------------------------------------------------------------- +%%%Callback functions from gen_server +%%%---------------------------------------------------------------------- + +%%---------------------------------------------------------------------- +%% Func: init/1 +%% Returns: {ok, State} | +%% {ok, State, Timeout} | +%% ignore | +%% {stop, Reason} +%%---------------------------------------------------------------------- +init(Args) -> + case xref_base:new(Args) of + {ok, S} -> + {ok, S}; + {error, _Module, Reason} -> + {stop, Reason} + end. + +%%---------------------------------------------------------------------- +%% Func: handle_call/3 +%% Returns: {reply, Reply, State} | +%% {reply, Reply, State, Timeout} | +%% {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, Reply, State} | (terminate/2 is called) +%% {stop, Reason, State} (terminate/2 is called) +%%---------------------------------------------------------------------- +handle_call(stop, _From, State) -> + {stop, normal, stopped, State}; +handle_call({add_release, Dir}, _From, State) -> + case xref_base:add_release(State, Dir) of + {ok, ReleaseName, NewState} -> + {reply, {ok, ReleaseName}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({add_release, Dir, Options}, _From, State) -> + case xref_base:add_release(State, Dir, Options) of + {ok, ReleaseName, NewState} -> + {reply, {ok, ReleaseName}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({add_application, Dir}, _From, State) -> + case xref_base:add_application(State, Dir) of + {ok, AppName, NewState} -> + {reply, {ok, AppName}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({add_application, Dir, Options}, _From, State) -> + case xref_base:add_application(State, Dir, Options) of + {ok, AppName, NewState} -> + {reply, {ok, AppName}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({add_module, File}, _From, State) -> + case xref_base:add_module(State, File) of + {ok, Module, NewState} -> + {reply, {ok, Module}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({add_module, File, Options}, _From, State) -> + case xref_base:add_module(State, File, Options) of + {ok, Module, NewState} -> + {reply, {ok, Module}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({replace_application, Appl, Dir}, _From, State) -> + case xref_base:replace_application(State, Appl, Dir) of + {ok, AppName, NewState} -> + {reply, {ok, AppName}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({replace_application, Appl, Dir, Opts}, _From, State) -> + case xref_base:replace_application(State, Appl, Dir, Opts) of + {ok, AppName, NewState} -> + {reply, {ok, AppName}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({remove_module, Mod}, _From, State) -> + case xref_base:remove_module(State, Mod) of + {ok, NewState} -> + {reply, ok, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({remove_application, Appl}, _From, State) -> + case xref_base:remove_application(State, Appl) of + {ok, NewState} -> + {reply, ok, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({remove_release, Rel}, _From, State) -> + case xref_base:remove_release(State, Rel) of + {ok, NewState} -> + {reply, ok, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({add_directory, Dir}, _From, State) -> + case xref_base:add_directory(State, Dir) of + {ok, Modules, NewState} -> + {reply, {ok, Modules}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({add_directory, Dir, Options}, _From, State) -> + case xref_base:add_directory(State, Dir, Options) of + {ok, Modules, NewState} -> + {reply, {ok, Modules}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call(get_library_path, _From, State) -> + Path = xref_base:get_library_path(State), + {reply, Path, State}; +handle_call({set_library_path, Path}, _From, State) -> + case xref_base:set_library_path(State, Path) of + {ok, NewState} -> + {reply, ok, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({set_library_path, Path, Options}, _From, State) -> + case xref_base:set_library_path(State, Path, Options) of + {ok, NewState} -> + {reply, ok, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({replace_module, Module, File}, _From, State) -> + case xref_base:replace_module(State, Module, File) of + {ok, Module, NewState} -> + {reply, {ok, Module}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({replace_module, Module, File, Options}, _From, State) -> + case xref_base:replace_module(State, Module, File, Options) of + {ok, Module, NewState} -> + {reply, {ok, Module}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call(info, _From, State) -> + {reply, xref_base:info(State), State}; +handle_call({info, What}, _From, State) -> + {reply, xref_base:info(State, What), State}; +handle_call({info, What, Qual}, _From, State) -> + {reply, xref_base:info(State, What, Qual), State}; +handle_call(update, _From, State) -> + case xref_base:update(State) of + {ok, NewState, Modules} -> + {reply, {ok, Modules}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({update, Options}, _From, State) -> + case xref_base:update(State, Options) of + {ok, NewState, Modules} -> + {reply, {ok, Modules}, NewState}; + Error -> + {reply, Error, State} + end; +handle_call(forget, _From, State) -> + {ok, NewState} = xref_base:forget(State), + {reply, ok, NewState}; +handle_call({forget, Variable}, _From, State) -> + case xref_base:forget(State, Variable) of + {ok, NewState} -> + {reply, ok, NewState}; + Error -> + {reply, Error, State} + end; +handle_call(variables, _From, State) -> + %% The reason the ok-Error pattern is broken for variables, q and + %% analyze is that the state may have been updated even if an + %% error occurs. + {Reply, NewState} = xref_base:variables(State), + {reply, Reply, NewState}; +handle_call({variables, Options}, _From, State) -> + {Reply, NewState} = xref_base:variables(State, Options), + {reply, Reply, NewState}; +handle_call({analyze, What}, _From, State) -> + {Reply, NewState} = xref_base:analyze(State, What), + {reply, unsetify(Reply), NewState}; +handle_call({analyze, What, Options}, _From, State) -> + {Reply, NewState} = xref_base:analyze(State, What, Options), + {reply, unsetify(Reply), NewState}; +handle_call({qry, Q}, _From, State) -> + {Reply, NewState} = xref_base:q(State, Q), + {reply, unsetify(Reply), NewState}; +handle_call({qry, Q, Options}, _From, State) -> + {Reply, NewState} = xref_base:q(State, Q, Options), + {reply, unsetify(Reply), NewState}; +handle_call(get_default, _From, State) -> + Reply = xref_base:get_default(State), + {reply, Reply, State}; +handle_call({get_default, Option}, _From, State) -> + Reply = xref_base:get_default(State, Option), + {reply, Reply, State}; +handle_call({set_default, OptionValues}, _From, State) -> + case xref_base:set_default(State, OptionValues) of + {ok, NewState} -> + {reply, ok, NewState}; + Error -> + {reply, Error, State} + end; +handle_call({set_default, Option, Value}, _From, State) -> + case xref_base:set_default(State, Option, Value) of + {ok, OldValue, NewState} -> + {reply, {ok, OldValue}, NewState}; + Error -> + {reply, Error, State} + end. + +%%---------------------------------------------------------------------- +%% Func: handle_cast/2 +%% Returns: {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%%---------------------------------------------------------------------- +handle_cast(_Msg, State) -> {noreply, State}. + +%%---------------------------------------------------------------------- +%% Func: handle_info/2 +%% Returns: {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%%---------------------------------------------------------------------- +handle_info(_Info, State) -> + {noreply, State}. + +%%---------------------------------------------------------------------- +%% Func: terminate/2 +%% Purpose: Shutdown the server +%% Returns: any (ignored by gen_server) +%%---------------------------------------------------------------------- +terminate(_Reason, _State) -> + ok. + +%%---------------------------------------------------------------------- +%% Func: code_change/3 +%% Purpose: Convert process state when code is changed +%% Returns: {ok, NewState} +%%---------------------------------------------------------------------- +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%---------------------------------------------------------------------- +%%% Internal functions +%%%---------------------------------------------------------------------- + +do_functions_analysis(FFun) -> + {ok, State} = xref_base:new(), + {ok, State1} = xref_base:set_library_path(State, code_path), + {ok, State2} = xref_base:set_default(State1, + [{verbose,false},{warnings,false}]), + State3 = case FFun(State2) of + {ok, _, S} -> S; + Error2 -> throw(Error2) + end, + {Undef, State4} = do_analysis(State3, undefined_function_calls), + {Unused, State5} = do_analysis(State4, locals_not_used), + {Deprecated, _} = do_analysis(State5, deprecated_function_calls), + [{deprecated,to_external(Deprecated)}, + {undefined,to_external(Undef)}, + {unused,to_external(Unused)}]. + +do_modules_analysis(FFun) -> + {ok, State} = xref_base:new({xref_mode, modules}), + {ok, State1} = xref_base:set_library_path(State, code_path), + {ok, State2} = xref_base:set_default(State1, + [{verbose,false},{warnings,false}]), + State3 = case FFun(State2) of + {ok, _, S} -> S; + Error2 -> throw(Error2) + end, + {Undef, State4} = do_analysis(State3, undefined_functions), + {Deprecated, _} = do_analysis(State4, deprecated_functions), + [{deprecated,to_external(Deprecated)}, + {undefined,to_external(Undef)}]. + +do_analysis(State, Analysis) -> + case xref_base:analyze(State, Analysis) of + {{ok, Reply}, NewState} -> + {Reply, NewState}; + {Error, _} -> + throw(Error) + end. + +unsetify(Reply={ok, X}) -> + case is_sofs_set(X) of + true -> {ok, to_external(X)}; + false -> Reply + end; +unsetify(Reply) -> + Reply. diff --git a/lib/tools/src/xref.hrl b/lib/tools/src/xref.hrl new file mode 100644 index 0000000000..fa8c5c746d --- /dev/null +++ b/lib/tools/src/xref.hrl @@ -0,0 +1,106 @@ +%% +%% %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% +%% + +%%% This file is meant to be included by xref_* only. + +-define(VAR_EXPR, '$F_EXPR'). +-define(MOD_EXPR, '$M_EXPR'). + +%%% Filenames are stored as directory and basename. A lot of heap can +%%% be saved by keeping only one (or few) copy of the directory name. + +%% 'data' in xref_mod holds "raw" data (as sets) for each module. The +%% data in 'variables' is derived from raw data. +-record(xref, { + version = 1, % version of the xref record + mode = functions, + variables = not_set_up, % table of variables + + modules = dict:new(), % dict-of(xref_mod()) + applications = dict:new(), % dict-of(xref_app()) + releases = dict:new(), % dict-of(xref_rel()) + + library_path = [], % [string()] | code_path + libraries = dict:new(), % dict-of(xref_lib()) + + builtins_default = false, % Default value of the 'builtins' option. + recurse_default = false, % Default value of the 'recurse' option. + verbose_default = false, % Default value of the 'verbose' option. + warnings_default = true % Default value of the 'warnings' option. + }). + +-record(xref_mod, { + name = '', + app_name = [], % [] or [AppName] + dir = "", % string(), directory where the BEAM file resides + mtime, % modification time for file + builtins, % whether calls to built-in functions are included + info, % number of exports, locals etc. + no_unresolved = 0, % number of unresolved calls + data + %% Data has been read from the BEAM file, and is represented here + %% as a list of sets. + %% If xref.mode = functions: + %% [ + %% DefAt, M -> P(V * N) + %% L, M -> P(V) + %% X, M -> P(V) + %% LCallAt, M -> P(V * V -> P(N)) + %% XCallAt, M -> P(V * V -> P(N)) + %% CallAt, M -> P(V * V -> P(N)) + %% LC, M -> P(V * V) + %% XC, M -> P(V * V) + %% LU, M -> P(V) + %% EE, M -> P(EV * EV) + %% ECallAt, M -> P(EV * EV -> P(N)) + %% Unres, M -> P(V * V) + %% LPredefined M -> P(V) + %% ] + %% + %% If xref.mode = modules: + %% [ + %% X, M -> P(V) + %% I M -> P(V) + %% ] + }). + +-record(xref_app, { + name = '', + rel_name = [], % [] or [RelName] + vsn = [], + dir = "" % where BEAM files are read from + }). + +-record(xref_rel, { + name = '', + dir = "" % where application directories reside + }). + +-record(xref_lib, { + name = '', % atom(), module name + dir = "" % string(), directory where the file resides + }). + +-record(xref_var, { + name = '', % atom(), variable name + value, % set or pair of sets, variable value + vtype, % VarType (predef, tmp, user) + otype, % ObjectType (vertex, edge, etc.) + type % Type (function, module, etc.) + }). diff --git a/lib/tools/src/xref_base.erl b/lib/tools/src/xref_base.erl new file mode 100644 index 0000000000..d0dbf4a2b4 --- /dev/null +++ b/lib/tools/src/xref_base.erl @@ -0,0 +1,1804 @@ +%% +%% %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(xref_base). + +-export([new/0, new/1, delete/1, + add_directory/2, add_directory/3, + add_module/2, add_module/3, + add_application/2, add_application/3, + replace_module/3, replace_module/4, + replace_application/3, replace_application/4, + remove_module/2, remove_application/2, remove_release/2, + add_release/2, add_release/3, + get_library_path/1, set_library_path/2, set_library_path/3, + set_up/1, set_up/2, + q/2, q/3, info/1, info/2, info/3, update/1, update/2, + forget/1, forget/2, variables/1, variables/2, + analyze/2, analyze/3, analysis/1, + get_default/2, set_default/3, + get_default/1, set_default/2]). + +-export([format_error/1]). + +%% The following functions are exported for testing purposes only: +-export([do_add_module/4, do_add_application/2, do_add_release/2, + do_remove_module/2]). + +-import(lists, + [filter/2, flatten/1, foldl/3, keysearch/3, map/2, mapfoldl/3, + member/2, reverse/1, sort/1, usort/1]). + +-import(sofs, + [constant_function/2, converse/1, difference/2, domain/1, + empty_set/0, family/1, family_difference/2, intersection/2, + family_projection/2, family_to_relation/1, family_union/1, + family_union/2, from_sets/1, from_term/1, a_function/1, + image/2, family_intersection/2, inverse/1, is_empty_set/1, + multiple_relative_product/2, no_elements/1, + partition_family/2, projection/2, range/1, relation/1, + relation_to_family/1, relative_product1/2, restriction/2, + restriction/3, set/1, specification/2, substitution/2, + to_external/1, union/1, union/2, union_of_family/1]). + +-include("xref.hrl"). + +-define(Suffix, ".beam"). + +%-define(debug, true). + +-ifdef(debug). +-define(FORMAT(P, A), io:format(P, A)). +-else. +-define(FORMAT(P, A), ok). +-endif. + +%% +%% Exported functions +%% + +new() -> + new([]). + +%% -> {ok, InitialState} +new(Options) -> + Modes = [functions,modules,function,module], + case xref_utils:options(Options, [{xref_mode,Modes}]) of + {[[function]], []} -> + {ok, #xref{mode = functions}}; + {[[module]], []} -> + {ok, #xref{mode = modules}}; + {[[OM]], []} -> + {ok, #xref{mode = OM}}; + _ -> + error({invalid_options, Options}) + end. + +%% -> ok +%% Need not be called by the server. +delete(State) when State#xref.variables =:= not_set_up -> + ok; +delete(State) -> + Fun = fun({X, _}) -> + case catch digraph:info(X) of + Info when is_list(Info) -> + true = digraph:delete(X); + _Else -> + ok + end + end, + map(Fun, dict:to_list(State#xref.variables)), + ok. + +add_directory(State, Dir) -> + add_directory(State, Dir, []). + +%% -> {ok, Modules, NewState} | Error +add_directory(State, Dir, Options) -> + ValOptions = option_values([builtins, recurse, verbose, warnings], State), + case xref_utils:options(Options, ValOptions) of + {[[OB], [OR], [OV], [OW]], []} -> + catch do_add_directory(Dir, [], OB, OR, OV, OW, State); + _ -> + error({invalid_options, Options}) + end. + +add_module(State, File) -> + add_module(State, File, []). + +%% -> {ok, Module, NewState} | Error +add_module(State, File, Options) -> + ValOptions = option_values([builtins, verbose, warnings], State), + case xref_utils:options(Options, ValOptions) of + {[[OB], [OV], [OW]], []} -> + case catch do_add_a_module(File, [], OB, OV, OW, State) of + {ok, [Module], NewState} -> + {ok, Module, NewState}; + {ok, [], _NewState} -> + error({no_debug_info, File}); + Error -> + Error + end; + _ -> + error({invalid_options, Options}) + end. + +add_application(State, AppDir) -> + add_application(State, AppDir, []). + +%% -> {ok, AppName, NewState} | Error +add_application(State, AppDir, Options) -> + OptVals = option_values([builtins, verbose, warnings], State), + ValidOptions = [{name, ["", fun check_name/1]} | OptVals], + case xref_utils:options(Options, ValidOptions) of + {[ApplName, [OB], [OV], [OW]], []} -> + catch do_add_application(AppDir, [], ApplName, OB, OV, OW, State); + _ -> + error({invalid_options, Options}) + end. + +replace_module(State, Module, File) -> + replace_module(State, Module, File, []). + +%% -> {ok, Module, NewState} | Error +replace_module(State, Module, File, Options) -> + ValidOptions = option_values([verbose, warnings], State), + case xref_utils:options(Options, ValidOptions) of + {[[OV], [OW]], []} -> + catch do_replace_module(Module, File, OV, OW, State); + _ -> + error({invalid_options, Options}) + end. + +replace_application(State, Appl, Dir) -> + replace_application(State, Appl, Dir, []). + +%% -> {ok, AppName, NewState} | Error +replace_application(State, Appl, Dir, Options) -> + ValidOptions = option_values([builtins, verbose, warnings], State), + case xref_utils:options(Options, ValidOptions) of + {[[OB], [OV], [OW]], []} -> + catch do_replace_application(Appl, Dir, OB, OV, OW, State); + _ -> + error({invalid_options, Options}) + end. + +%% -> {ok, NewState} | Error +remove_module(State, Mod) when is_atom(Mod) -> + remove_module(State, [Mod]); +remove_module(State, [Mod | Mods]) -> + case catch do_remove_module(State, Mod) of + {ok, _OldXMod, NewState} -> + remove_module(NewState, Mods); + Error -> + Error + end; +remove_module(State, []) -> + {ok, State}. + +%% -> {ok, NewState} | Error +remove_application(State, Appl) when is_atom(Appl) -> + remove_application(State, [Appl]); +remove_application(State, [Appl | Appls]) -> + case catch do_remove_application(State, Appl) of + {ok, _OldXApp, NewState} -> + remove_application(NewState, Appls); + Error -> + Error + end; +remove_application(State, []) -> + {ok, State}. + +%% -> {ok, NewState} | Error +remove_release(State, Rel) when is_atom(Rel) -> + remove_release(State, [Rel]); +remove_release(State, [Rel | Rels]) -> + case catch do_remove_release(State, Rel) of + {ok, _OldXRel, NewState} -> + remove_release(NewState, Rels); + Error -> + Error + end; +remove_release(State, []) -> + {ok, State}. + +add_release(State, RelDir) -> + add_release(State, RelDir, []). + +%% -> {ok, ReleaseName, NewState} | Error +add_release(State, RelDir, Options) -> + ValidOptions0 = option_values([builtins, verbose, warnings], State), + ValidOptions = [{name, ["", fun check_name/1]} | ValidOptions0], + case xref_utils:options(Options, ValidOptions) of + {[RelName, [OB], [OV], [OW]], []} -> + catch do_add_release(RelDir, RelName, OB, OV, OW, State); + _ -> + error({invalid_options, Options}) + end. + +get_library_path(State) -> + {ok, State#xref.library_path}. + +set_library_path(State, Path) -> + set_library_path(State, Path, []). + +%% -> {ok, NewState} | Error +set_library_path(State, code_path, _Options) -> + S1 = State#xref{library_path = code_path, libraries = dict:new()}, + {ok, take_down(S1)}; +set_library_path(State, Path, Options) -> + case xref_utils:is_path(Path) of + true -> + ValidOptions = option_values([verbose], State), + case xref_utils:options(Options, ValidOptions) of + {[[OV]], []} -> + do_add_libraries(Path, OV, State); + _ -> + error({invalid_options, Options}) + end; + false -> + error({invalid_path, Path}) + end. + +set_up(State) -> + set_up(State, []). + +%% -> {ok, NewState} | Error +set_up(State, Options) -> + ValidOptions = option_values([verbose], State), + case xref_utils:options(Options, ValidOptions) of + {[[Verbose]], []} -> + do_set_up(State, Verbose); + _ -> + error({invalid_options, Options}) + end. + +q(S, Q) -> + q(S, Q, []). + +%% -> {{ok, Answer}, NewState} | {Error, NewState} +q(S, Q, Options) when is_atom(Q) -> + q(S, atom_to_list(Q), Options); +q(S, Q, Options) -> + case xref_utils:is_string(Q, 1) of + true -> + case set_up(S, Options) of + {ok, S1} -> + case xref_compiler:compile(Q, S1#xref.variables) of + {NewT, Ans} -> + {{ok, Ans}, S1#xref{variables = NewT}}; + Error -> + {Error, S1} + end; + Error -> + {Error, S} + end; + false -> + {error({invalid_query, Q}), S} + end. + +%% -> InfoList +info(State) -> + D0 = sort(dict:to_list(State#xref.modules)), + D = map(fun({_M, XMod}) -> XMod end, D0), + NoApps = length(dict:to_list(State#xref.applications)), + NoRels = length(dict:to_list(State#xref.releases)), + No = no_sum(State, D), + [{library_path, State#xref.library_path}, {mode, State#xref.mode}, + {no_releases, NoRels}, {no_applications, NoApps}] ++ No. + +info(State, What) -> + do_info(State, What). + +%% -> [{what(), InfoList}] +info(State, What, Qual) -> + catch do_info(State, What, Qual). + +update(State) -> + update(State, []). + +%% -> {ok, NewState, Modules} | Error +update(State, Options) -> + ValidOptions = option_values([verbose, warnings], State), + case xref_utils:options(Options, ValidOptions) of + {[[OV],[OW]], []} -> + catch do_update(OV, OW, State); + _ -> + error({invalid_options, Options}) + end. + +%% -> {ok, NewState} +forget(State) -> + {U, _P} = do_variables(State), + {ok, foldl(fun(V, S) -> {ok, NS} = forget(S, V), NS end, State, U)}. + +%% -> {ok, NewState} | Error +forget(State, Variable) when State#xref.variables =:= not_set_up -> + error({not_user_variable, Variable}); +forget(State, Variable) when is_atom(Variable) -> + forget(State, [Variable]); +forget(State, Variables) -> + Vars = State#xref.variables, + do_forget(Variables, Vars, Variables, State). + +variables(State) -> + variables(State, [user]). + +%% -> {{ok, Answer}, NewState} | {Error, NewState} +%% Answer = [{vartype(), [VariableName]}] +variables(State, Options) -> + ValidOptions = option_values([verbose], State), + case xref_utils:options(Options, [user, predefined | ValidOptions]) of + {[User,Predef,[OV]],[]} -> + case do_set_up(State, OV) of + {ok, NewState} -> + {U, P} = do_variables(NewState), + R1 = if User -> [{user, U}]; true -> [] end, + R = if + Predef -> [{predefined,P} | R1]; + true -> R1 + end, + {{ok, R}, NewState}; + Error -> + {Error, State} + end; + _ -> + {error({invalid_options, Options}), State} + end. + +analyze(State, Analysis) -> + analyze(State, Analysis, []). + +%% -> {{ok, Answer}, NewState} | {Error, NewState} +analyze(State, Analysis, Options) -> + case analysis(Analysis, State#xref.mode) of + P when is_list(P) -> + q(State, P, Options); + error -> + R = case analysis(Analysis, functions) of + error -> unknown_analysis; + P when is_list(P) -> unavailable_analysis + end, + Error = error({R, Analysis}), + {Error, State} + end. + +analysis(Analysis) -> + analysis(Analysis, functions). + +%% -> string() | Error +analysis(undefined_function_calls, functions) -> + "(XC - UC) || (XU - X - B)"; +analysis(undefined_functions, modules) -> + %% "XU * (L + U)" is equivalent, but the following works when L is + %% not available. + "XU - X - B"; +analysis(undefined_functions, functions) -> + %% "XU * ((L + U) - range UC)" is equivalent. + "XU - range UC - X - B"; +analysis(locals_not_used, functions) -> + %% The Inter Call Graph is used to get local functions that are not + %% used (indirectly) from any export: "(domain EE + range EE) * L". + %% But then we only get locals that make some calls, so we add + %% locals that are not used at all: "L * (UU + XU - LU)". + "L * ((UU + XU - LU) + domain EE + range EE)"; +analysis(exports_not_used, _) -> + %% Local calls are not considered here. "X * UU" would do otherwise. + "X - XU"; +analysis({call, F}, functions) -> + make_query("range (E | ~w : Fun)", [F]); +analysis({use, F}, functions) -> + make_query("domain (E || ~w : Fun)", [F]); +analysis({module_call, M}, _) -> + make_query("range (ME | ~w : Mod)", [M]); +analysis({module_use, M}, _) -> + make_query("domain (ME || ~w : Mod)", [M]); +analysis({application_call, A}, _) -> + make_query("range (AE | ~w : App)", [A]); +analysis({application_use, A}, _) -> + make_query("domain (AE || ~w : App)", [A]); +analysis({release_call, R}, _) -> + make_query("range (RE | ~w : Rel)", [R]); +analysis({release_use, R}, _) -> + make_query("domain (RE || ~w : Rel)", [R]); +analysis(deprecated_function_calls, functions) -> + "XC || DF"; +analysis({deprecated_function_calls,Flag}, functions) -> + case deprecated_flag(Flag) of + undefined -> error; + I -> make_query("XC || DF_~w", [I]) + end; +analysis(deprecated_functions, _) -> + "XU * DF"; +analysis({deprecated_functions,Flag}, _) -> + case deprecated_flag(Flag) of + undefined -> error; + I -> make_query("XU * DF_~w", [I]) + end; +analysis(_, _) -> + error. + +%% -> {ok, OldValue, NewState} | Error +set_default(State, Option, Value) -> + case get_default(State, Option) of + {ok, OldValue} -> + Values = option_values([Option], State), + case xref_utils:options([{Option,Value}], Values) of + {_, []} -> + NewState = set_def(Option, Value, State), + {ok, OldValue, NewState}; + {_, Unknown} -> + error({invalid_options, Unknown}) + end; + Error -> + Error + end. + +%% -> {ok, Value} | Error +get_default(State, Option) -> + case catch current_default(State, Option) of + {'EXIT', _} -> + error({invalid_options, [Option]}); + Value -> + {ok, Value} + end. + +%% -> [{Option, Value}] +get_default(State) -> + Fun = fun(O) -> V = current_default(State, O), {O, V} end, + map(Fun, [builtins, recurse, verbose, warnings]). + +%% -> {ok, NewState} -> Error +set_default(State, Options) -> + Opts = [builtins, recurse, verbose, warnings], + ValidOptions = option_values(Opts, State), + case xref_utils:options(Options, ValidOptions) of + {Values = [[_], [_], [_], [_]], []} -> + {ok, set_defaults(Opts, Values, State)}; + _ -> + error({invalid_options, Options}) + end. + +format_error({error, Module, Error}) -> + Module:format_error(Error); +format_error({invalid_options, Options}) -> + io_lib:format("Unknown option(s) or invalid option value(s): ~p~n", + [Options]); +format_error({invalid_filename, Term}) -> + io_lib:format("A file name (a string) was expected: ~p~n", [Term]); +format_error({no_debug_info, FileName}) -> + io_lib:format("The BEAM file ~p has no debug info~n", [FileName]); +format_error({invalid_path, Term}) -> + io_lib:format("A path (a list of strings) was expected: ~p~n", [Term]); +format_error({invalid_query, Term}) -> + io_lib:format("A query (a string or an atom) was expected: ~p~n", [Term]); +format_error({not_user_variable, Variable}) -> + io_lib:format("~p is not a user variable~n", [Variable]); +format_error({unknown_analysis, Term}) -> + io_lib:format("~p is not a predefined analysis~n", [Term]); +format_error({module_mismatch, Module, ReadModule}) -> + io_lib:format("Name of read module ~p does not match analyzed module ~p~n", + [ReadModule, Module]); +format_error({release_clash, {Release, Dir, OldDir}}) -> + io_lib:format("The release ~p read from ~p clashes with release " + "already read from ~p~n", [Release, Dir, OldDir]); +format_error({application_clash, {Application, Dir, OldDir}}) -> + io_lib:format("The application ~p read from ~p clashes with application " + "already read from ~p~n", [Application, Dir, OldDir]); +format_error({module_clash, {Module, Dir, OldDir}}) -> + io_lib:format("The module ~p read from ~p clashes with module " + "already read from ~p~n", [Module, Dir, OldDir]); +format_error({no_such_release, Name}) -> + io_lib:format("There is no analyzed release ~p~n", [Name]); +format_error({no_such_application, Name}) -> + io_lib:format("There is no analyzed application ~p~n", [Name]); +format_error({no_such_module, Name}) -> + io_lib:format("There is no analyzed module ~p~n", [Name]); +format_error({no_such_info, Term}) -> + io_lib:format("~p is not one of 'modules', 'applications', " + "'releases' and 'libraries'~n", [Term]); +format_error(E) -> + io_lib:format("~p~n", [E]). + +%% +%% Local functions +%% + +check_name([N]) when is_atom(N) -> true; +check_name(_) -> false. + +do_update(OV, OW, State) -> + Changed = updated_modules(State), + Fun = fun({Mod,File}, S) -> + {ok, _M, NS} = do_replace_module(Mod, File, OV, OW, S), + NS + end, + NewState = foldl(Fun, State, Changed), + {ok, NewState, to_external(domain(a_function(Changed)))}. + +%% -> [{Module, File}] +updated_modules(State) -> + Fun = fun({M,XMod}, L) -> + RTime = XMod#xref_mod.mtime, + File = module_file(XMod), + case xref_utils:file_info(File) of + {ok, {_, file, readable, MTime}} when MTime =/= RTime -> + [{M,File} | L]; + _Else -> + L + end + end, + foldl(Fun, [], dict:to_list(State#xref.modules)). + +do_forget([Variable | Variables], Vars, Vs, State) -> + case dict:find(Variable, Vars) of + {ok, #xref_var{vtype = user}} -> + do_forget(Variables, Vars, Vs, State); + _ -> + error({not_user_variable, Variable}) + end; +do_forget([], Vars, Vs, State) -> + Fun = fun(V, VT) -> + {ok, #xref_var{value = Value}} = dict:find(V, VT), + VT1 = xref_compiler:update_graph_counter(Value, -1, VT), + dict:erase(V, VT1) + end, + NewVars = foldl(Fun, Vars, Vs), + NewState = State#xref{variables = NewVars}, + {ok, NewState}. + +%% -> {ok, Module, State} | throw(Error) +do_replace_module(Module, File, OV, OW, State) -> + {ok, OldXMod, State1} = do_remove_module(State, Module), + OldApp = OldXMod#xref_mod.app_name, + OB = OldXMod#xref_mod.builtins, + case do_add_a_module(File, OldApp, OB, OV, OW, State1) of + {ok, [Module], NewState} -> + {ok, Module, NewState}; + {ok, [ReadModule], _State} -> + throw_error({module_mismatch, Module, ReadModule}); + {ok, [], _NewState} -> + throw_error({no_debug_info, File}) + end. + +do_replace_application(Appl, Dir, OB, OV, OW, State) -> + {ok, OldXApp, State1} = do_remove_application(State, Appl), + Rel = OldXApp#xref_app.rel_name, + N = OldXApp#xref_app.name, + %% The application name is kept; the name of Dir is not used + %% as source for a "new" application name. + do_add_application(Dir, Rel, [N], OB, OV, OW, State1). + +%% -> {ok, ReleaseName, NewState} | throw(Error) +do_add_release(Dir, RelName, OB, OV, OW, State) -> + ok = is_filename(Dir), + case xref_utils:release_directory(Dir, true, "ebin") of + {ok, ReleaseDirName, ApplDir, Dirs} -> + ApplDirs = xref_utils:select_last_application_version(Dirs), + Release = case RelName of + [[]] -> ReleaseDirName; + [Name] -> Name + end, + XRel = #xref_rel{name = Release, dir = ApplDir}, + NewState = do_add_release(State, XRel), + add_rel_appls(ApplDirs, [Release], OB, OV, OW, NewState); + Error -> + throw(Error) + end. + +do_add_release(S, XRel) -> + Release = XRel#xref_rel.name, + case dict:find(Release, S#xref.releases) of + {ok, OldXRel} -> + Dir = XRel#xref_rel.dir, + OldDir = OldXRel#xref_rel.dir, + throw_error({release_clash, {Release, Dir, OldDir}}); + error -> + D1 = dict:store(Release, XRel, S#xref.releases), + S#xref{releases = D1} + end. + +add_rel_appls([ApplDir | ApplDirs], Release, OB, OV, OW, State) -> + {ok, _AppName, NewState} = + add_appldir(ApplDir, Release, [[]], OB, OV, OW, State), + add_rel_appls(ApplDirs, Release, OB, OV, OW, NewState); +add_rel_appls([], [Release], _OB, _OV, _OW, NewState) -> + {ok, Release, NewState}. + +do_add_application(Dir0, Release, Name, OB, OV, OW, State) -> + ok = is_filename(Dir0), + case xref_utils:select_application_directories([Dir0], "ebin") of + {ok, [ApplD]} -> + add_appldir(ApplD, Release, Name, OB, OV, OW, State); + Error -> + throw(Error) + end. + +%% -> {ok, AppName, NewState} | throw(Error) +add_appldir(ApplDir, Release, Name, OB, OV, OW, OldState) -> + {AppName0, Vsn, Dir} = ApplDir, + AppName = case Name of + [[]] -> AppName0; + [N] -> N + end, + AppInfo = #xref_app{name = AppName, rel_name = Release, + vsn = Vsn, dir = Dir}, + State1 = do_add_application(OldState, AppInfo), + {ok, _Modules, NewState} = + do_add_directory(Dir, [AppName], OB, false, OV, OW, State1), + {ok, AppName, NewState}. + +%% -> State | throw(Error) +do_add_application(S, XApp) -> + Application = XApp#xref_app.name, + case dict:find(Application, S#xref.applications) of + {ok, OldXApp} -> + Dir = XApp#xref_app.dir, + OldDir = OldXApp#xref_app.dir, + throw_error({application_clash, {Application, Dir, OldDir}}); + error -> + D1 = dict:store(Application, XApp, S#xref.applications), + S#xref{applications = D1} + end. + +%% -> {ok, Modules, NewState} | throw(Error) +do_add_directory(Dir, AppName, Bui, Rec, Ver, War, State) -> + ok = is_filename(Dir), + {FileNames, Errors, Jams, Unreadable} = + xref_utils:scan_directory(Dir, Rec, [?Suffix], [".jam"]), + warnings(War, jam, Jams), + warnings(War, unreadable, Unreadable), + case Errors of + [] -> + do_add_modules(FileNames, AppName, Bui, Ver, War, State, []); + [Error | _] -> + throw(Error) + end. + +do_add_modules([], _AppName, _OB, _OV, _OW, State, Modules) -> + {ok, sort(Modules), State}; +do_add_modules([File | Files], AppName, OB, OV, OW, State, Modules) -> + {ok, M, NewState} = do_add_module(File, AppName, OB, OV, OW, State), + do_add_modules(Files, AppName, OB, OV, OW, NewState, M ++ Modules). + +%% -> {ok, Module, State} | throw(Error) +do_add_a_module(File, AppName, Builtins, Verbose, Warnings, State) -> + case xref_utils:split_filename(File, ?Suffix) of + false -> + throw_error({invalid_filename, File}); + Splitname -> + do_add_module(Splitname, AppName, Builtins, Verbose, + Warnings, State) + end. + +%% -> {ok, Module, State} | throw(Error) +%% Options: verbose, warnings, builtins +do_add_module({Dir, Basename}, AppName, Builtins, Verbose, Warnings, State) -> + File = filename:join(Dir, Basename), + {ok, M, Bad, NewState} = + do_add_module1(Dir, File, AppName, Builtins, Verbose, Warnings, State), + filter(fun({Tag,B}) -> warnings(Warnings, Tag, [[File,B]]) end, Bad), + {ok, M, NewState}. + +do_add_module1(Dir, File, AppName, Builtins, Verbose, Warnings, State) -> + message(Verbose, reading_beam, [File]), + Mode = State#xref.mode, + Me = self(), + Fun = fun() -> Me ! {self(), abst(File, Builtins, Mode)} end, + case xref_utils:subprocess(Fun, [link, {min_heap_size,100000}]) of + {ok, _M, no_abstract_code} when Verbose -> + message(Verbose, skipped_beam, []), + {ok, [], [], State}; + {ok, _M, no_abstract_code} when not Verbose -> + message(Warnings, no_debug_info, [File]), + {ok, [], [], State}; + {ok, M, Data, UnresCalls0} -> + %% Remove duplicates. Identical unresolved calls on the + %% same line are counted as _one_ unresolved call. + UnresCalls = usort(UnresCalls0), + message(Verbose, done, []), + NoUnresCalls = length(UnresCalls), + case NoUnresCalls of + 0 -> ok; + 1 -> warnings(Warnings, unresolved_summary1, [[M]]); + N -> warnings(Warnings, unresolved_summary, [[M, N]]) + end, + T = case xref_utils:file_info(File) of + {ok, {_, _, _, Time}} -> Time; + Error -> throw(Error) + end, + XMod = #xref_mod{name = M, app_name = AppName, dir = Dir, + mtime = T, builtins = Builtins, + no_unresolved = NoUnresCalls}, + do_add_module(State, XMod, UnresCalls, Data); + Error -> + message(Verbose, error, []), + throw(Error) + end. + +abst(File, Builtins, Mode) when Mode =:= functions -> + case beam_lib:chunks(File, [abstract_code, exports, attributes]) of + {ok, {M,[{abstract_code,NoA},_X,_A]}} when NoA =:= no_abstract_code -> + {ok, M, NoA}; + {ok, {M, [{abstract_code, {abstract_v1, Forms}}, + {exports,X0}, {attributes,A}]}} -> + %% R7. + X = xref_utils:fa_to_mfa(X0, M), + D = deprecated(A, X, M), + xref_reader:module(M, Forms, Builtins, X, D); + {ok, {M, [{abstract_code, {abstract_v2, Forms}}, + {exports,X0}, {attributes,A}]}} -> + %% R8-R9B. + X = xref_utils:fa_to_mfa(X0, M), + D = deprecated(A, X, M), + xref_reader:module(M, Forms, Builtins, X, D); + {ok, {M, [{abstract_code, {raw_abstract_v1, Code}}, + {exports,X0}, {attributes,A}]}} -> + %% R9C- + Forms0 = epp:interpret_file_attribute(Code), + {_,_,Forms,_} = sys_pre_expand:module(Forms0, []), + X = mfa_exports(X0, A, M), + D = deprecated(A, X, M), + xref_reader:module(M, Forms, Builtins, X, D); + Error when element(1, Error) =:= error -> + Error + end; +abst(File, Builtins, Mode) when Mode =:= modules -> + case beam_lib:chunks(File, [exports, imports, attributes]) of + {ok, {Mod, [{exports,X0}, {imports,I0}, {attributes,At}]}} -> + X1 = mfa_exports(X0, At, Mod), + X = filter(fun(MFA) -> not (predef_fun())(MFA) end, X1), + D = deprecated(At, X, Mod), + I = case Builtins of + true -> + I0; + false -> + Fun = fun({M,F,A}) -> + not xref_utils:is_builtin(M, F, A) + end, + filter(Fun, I0) + end, + {ok, Mod, {X, I, D}, []}; + Error when element(1, Error) =:= error -> + Error + end. + +mfa_exports(X0, Attributes, M) -> + %% Adjust arities for abstract modules. + X1 = case xref_utils:is_abstract_module(Attributes) of + true -> + [{F,adjust_arity(F,A)} || {F,A} <- X0]; + false -> + X0 + end, + xref_utils:fa_to_mfa(X1, M). + +adjust_arity(F, A) -> + case xref_utils:is_static_function(F, A) of + true -> A; + false -> A - 1 + end. + +deprecated(A, X, M) -> + DF = {[],[],[],[]}, + case keysearch(deprecated, 1, A) of + {value, {deprecated, D0}} -> + depr(D0, M, DF, X, []); + false -> + {DF,[]} + end. + +depr([D | Depr], M, DF, X, Bad) -> + case depr_cat(D, M, X) of + {I,Dt} -> + NDF = setelement(I, DF, Dt ++ element(I, DF)), + depr(Depr, M, NDF, X, Bad); + undefined -> + depr(Depr, M, DF, X, [D | Bad]) + end; +depr([], _M, DF, _X, Bad) -> + {DF, reverse(Bad)}. + +depr_cat({F, A, Flg}, M, X) -> + case deprecated_flag(Flg) of + undefined -> undefined; + I -> depr_fa(F, A, X, M, I) + end; +depr_cat({F, A}, M, X) -> + depr_fa(F, A, X, M, 4); +depr_cat(module, M, X) -> + depr_fa('_', '_', X, M, 4); +depr_cat(_D, _M, _X) -> + undefined. + +depr_fa('_', '_', X, _M, I) -> + {I, X}; +depr_fa(F, '_', X, _M, I) when is_atom(F) -> + {I, filter(fun({_,F1,_}) -> F1 =:= F end, X)}; +depr_fa(F, A, _X, M, I) when is_atom(F), is_integer(A), A >= 0 -> + {I, [{M,F,A}]}; +depr_fa(_F, _A, _X, _M, _I) -> + undefined. + +%% deprecated_flag(Flag) -> integer() | undefined +%% Maps symbolic flags for deprecated functions to integers. + +%deprecated_flag(1) -> 1; +%deprecated_flag(2) -> 2; +%deprecated_flag(3) -> 3; +deprecated_flag(next_version) -> 1; +deprecated_flag(next_major_release) -> 2; +deprecated_flag(eventually) -> 3; +deprecated_flag(_) -> undefined. + +%% -> {ok, Module, Bad, State} | throw(Error) +%% Assumes: +%% L U X is a subset of dom DefAt +%% dom CallAt = LC U XC +%% Attrs is collected from the attribute 'xref' (experimental). +do_add_module(S, XMod, Unres, Data) -> + M = XMod#xref_mod.name, + case dict:find(M, S#xref.modules) of + {ok, OldXMod} -> + BF2 = module_file(XMod), + BF1 = module_file(OldXMod), + throw_error({module_clash, {M, BF1, BF2}}); + error -> + do_add_module(S, M, XMod, Unres, Data) + end. + +%%do_add_module(S, M, _XMod, _Unres, Data)-> +%% {ok, M, [], S}; +do_add_module(S, M, XMod, Unres0, Data) when S#xref.mode =:= functions -> + {DefAt0, LPreCAt0, XPreCAt0, LC0, XC0, X0, Attrs, Depr} = Data, + %% Bad is a list of bad values of 'xref' attributes. + {ALC0,AXC0,Bad0} = Attrs, + FT = [tspec(func)], + FET = [tspec(fun_edge)], + PCA = [tspec(pre_call_at)], + + XPreCAt1 = xref_utils:xset(XPreCAt0, PCA), + LPreCAt1 = xref_utils:xset(LPreCAt0, PCA), + DefAt = xref_utils:xset(DefAt0, [tspec(def_at)]), + X1 = xref_utils:xset(X0, FT), + XC1 = xref_utils:xset(XC0, FET), + LC1 = xref_utils:xset(LC0, FET), + AXC1 = xref_utils:xset(AXC0, PCA), + ALC1 = xref_utils:xset(ALC0, PCA), + UnresCalls = xref_utils:xset(Unres0, PCA), + Unres = domain(UnresCalls), + + DefinedFuns = domain(DefAt), + {AXC, ALC, Bad1, LPreCAt2, XPreCAt2} = + extra_edges(AXC1, ALC1, Bad0, DefinedFuns), + Bad = map(fun(B) -> {xref_attr, B} end, Bad1), + LPreCAt = union(LPreCAt1, LPreCAt2), + XPreCAt = union(XPreCAt1, XPreCAt2), + NoCalls = no_elements(LPreCAt) + no_elements(XPreCAt), + LCallAt = relation_to_family(LPreCAt), + XCallAt = relation_to_family(XPreCAt), + CallAt = family_union(LCallAt, XCallAt), + %% Local and exported functions with no definitions are removed. + L = difference(DefinedFuns, X1), + X = difference(DefinedFuns, L), + XC = union(XC1, AXC), + LC = union(LC1, ALC), + + {DF1,DF_11,DF_21,DF_31,DBad} = depr_mod(Depr, X), + + %% {EE, ECallAt} = inter_graph(X, L, LC, XC, LCallAt, XCallAt), + Self = self(), + Fun = fun() -> inter_graph(Self, X, L, LC, XC, CallAt) end, + {EE, ECallAt} = + xref_utils:subprocess(Fun, [link, {min_heap_size,100000}]), + + [DefAt2,L2,X2,LCallAt2,XCallAt2,CallAt2,LC2,XC2,EE2,ECallAt2, + DF2,DF_12,DF_22,DF_32] = + pack([DefAt,L,X,LCallAt,XCallAt,CallAt,LC,XC,EE,ECallAt, + DF1,DF_11,DF_21,DF_31]), + + %% Foo = [DefAt2,L2,X2,LCallAt2,XCallAt2,CallAt2,LC2,XC2,EE2,ECallAt2, + %% DF2,DF_12,DF_22,DF_32], + %% io:format("{~p, ~p, ~p},~n", [M, pack:lsize(Foo), pack:usize(Foo)]), + + LU = range(LC2), + + LPredefined = predefined_funs(LU), + + MS = xref_utils:xset(M, atom), + T = from_sets({MS,DefAt2,L2,X2,LCallAt2,XCallAt2,CallAt2, + LC2,XC2,LU,EE2,ECallAt2,Unres,LPredefined, + DF2,DF_12,DF_22,DF_32}), + + NoUnres = XMod#xref_mod.no_unresolved, + Info = no_info(X2, L2, LC2, XC2, EE2, Unres, NoCalls, NoUnres), + + XMod1 = XMod#xref_mod{data = T, info = Info}, + S1 = S#xref{modules = dict:store(M, XMod1, S#xref.modules)}, + {ok, [M], DBad++Bad, take_down(S1)}; +do_add_module(S, M, XMod, _Unres, Data) when S#xref.mode =:= modules -> + {X0, I0, Depr} = Data, + X1 = xref_utils:xset(X0, [tspec(func)]), + I1 = xref_utils:xset(I0, [tspec(func)]), + {DF1,DF_11,DF_21,DF_31,DBad} = depr_mod(Depr, X1), + [X2,I2,DF2,DF_12,DF_22,DF_32] = pack([X1,I1,DF1,DF_11,DF_21,DF_31]), + MS = xref_utils:xset(M, atom), + T = from_sets({MS, X2, I2, DF2, DF_12, DF_22, DF_32}), + Info = [], + XMod1 = XMod#xref_mod{data = T, info = Info}, + S1 = S#xref{modules = dict:store(M, XMod1, S#xref.modules)}, + {ok, [M], DBad, take_down(S1)}. + +depr_mod({Depr,Bad0}, X) -> + %% Bad0 are badly formed deprecated attributes. + %% Here deprecated functions that are neither BIFs nor exported + %% are deemed bad. do_set_up filters away BIFs if necessary. + {DF_10,DF_20,DF_30,DF0} = Depr, + FT = [tspec(func)], + DF1 = xref_utils:xset(DF0, FT), + DF_11 = xref_utils:xset(DF_10, FT), + DF_21 = xref_utils:xset(DF_20, FT), + DF_31 = xref_utils:xset(DF_30, FT), + + All = union(from_sets([DF1,DF_11,DF_21,DF_31])), + Fun = {external, fun({M,F,A}) -> xref_utils:is_builtin(M, F, A) end}, + XB = union(X, specification(Fun, All)), + DF_1 = intersection(DF_11, XB), + DF_2 = union(intersection(DF_21, XB), DF_1), + DF_3 = union(intersection(DF_31, XB), DF_2), + DF = union(intersection(DF1, XB), DF_3), + + Bad1 = difference(All, XB), + Bad2 = to_external(difference(Bad1, predefined_funs(Bad1))), + Bad = map(fun(B) -> {depr_attr, B} end, usort(Bad2++Bad0)), + {DF,DF_1,DF_2,DF_3,Bad}. + +%% Extra edges gathered from the attribute 'xref' (experimental) +extra_edges(CAX, CAL, Bad0, F) -> + AXC0 = domain(CAX), + ALC0 = domain(CAL), + AXC = restriction(AXC0, F), + ALC = restriction(2, restriction(ALC0, F), F), + LPreCAt2 = restriction(CAL, ALC), + XPreCAt2 = restriction(CAX, AXC), + Bad = Bad0 ++ to_external(difference(AXC0, AXC)) + ++ to_external(difference(ALC0, ALC)), + {AXC, ALC, Bad, LPreCAt2, XPreCAt2}. + +no_info(X, L, LC, XC, EE, Unres, NoCalls, NoUnresCalls) -> + NoUnres = no_elements(Unres), + [{no_calls, {NoCalls-NoUnresCalls, NoUnresCalls}}, + {no_function_calls, {no_elements(LC), no_elements(XC)-NoUnres, NoUnres}}, + {no_functions, {no_elements(L), no_elements(X)}}, + %% Note: this is overwritten in do_set_up(): + {no_inter_function_calls, no_elements(EE)}]. + +inter_graph(Pid, X, L, LC, XC, CallAt) -> + Pid ! {self(), inter_graph(X, L, LC, XC, CallAt)}. + +%% Inter Call Graph. +%inter_graph(_X, _L, _LC, _XC, _CallAt) -> +% {empty_set(), empty_set()}; +inter_graph(X, L, LC, XC, CallAt) -> + G = xref_utils:relation_to_graph(LC), + + Reachable0 = digraph_utils:reachable_neighbours(to_external(X), G), + Reachable = xref_utils:xset(Reachable0, [tspec(func)]), + % XL includes exports and locals that are not used by any exports + % (the locals are tacitly ignored in the comments below). + XL = union(difference(L, Reachable), X), + + % Immediate local calls between the module's own exports are qualified. + LEs = restriction(restriction(2, LC, XL), XL), + % External calls to the module's exports are qualified. + XEs = restriction(XC, XL), + Es = union(LEs, XEs), + + E1 = to_external(restriction(difference(LC, LEs), XL)), + R0 = xref_utils:xset(reachable(E1, G, []), + [{tspec(func), tspec(fun_edge)}]), + true = digraph:delete(G), + + % RL is a set of indirect local calls to exports. + RL = restriction(R0, XL), + % RX is a set of indirect external calls to exports. + RX = relative_product1(R0, XC), + R = union(RL, converse(RX)), + + EE0 = projection({external, fun({Ee2,{Ee1,_L}}) -> {Ee1,Ee2} end}, R), + EE = union(Es, EE0), + + % The first call in each chain, {e1,l}, contributes with the line + % number(s) l. + SFun = {external, fun({Ee2,{Ee1,Ls}}) -> {{Ee1,Ls},{Ee1,Ee2}} end}, + ECallAt1 = relative_product1(projection(SFun, R), CallAt), + ECallAt2 = union(ECallAt1, restriction(CallAt, Es)), + ECallAt = family_union(relation_to_family(ECallAt2)), + + ?FORMAT("XL=~p~nXEs=~p~nLEs=~p~nE1=~p~nR0=~p~nRL=~p~nRX=~p~nR=~p~n" + "EE=~p~nECallAt1=~p~nECallAt2=~p~nECallAt=~p~n~n", + [XL, XEs, LEs, E1, R0, RL, RX, R, EE, + ECallAt1, ECallAt2, ECallAt]), + {EE, ECallAt}. + +%% -> set of {V2,{V1,L1}} +reachable([E = {_X, L} | Xs], G, R) -> + Ns = digraph_utils:reachable([L], G), + reachable(Xs, G, reach(Ns, E, R)); +reachable([], _G, R) -> + R. + +reach([N | Ns], E, L) -> + reach(Ns, E, [{N, E} | L]); +reach([], _E, L) -> + L. + +tspec(func) -> {atom, atom, atom}; +tspec(fun_edge) -> {tspec(func), tspec(func)}; +tspec(def_at) -> {tspec(func), atom}; +tspec(pre_call_at) -> {tspec(fun_edge), atom}. + +%% -> {ok, OldXrefRel, NewState} | throw(Error) +do_remove_release(S, RelName) -> + case dict:find(RelName, S#xref.releases) of + error -> + throw_error({no_such_release, RelName}); + {ok, XRel} -> + S1 = take_down(S), + S2 = remove_rel(S1, RelName), + {ok, XRel, S2} + end. + +%% -> {ok, OldXrefApp, NewState} | throw(Error) +do_remove_application(S, AppName) -> + case dict:find(AppName, S#xref.applications) of + error -> + throw_error({no_such_application, AppName}); + {ok, XApp} -> + S1 = take_down(S), + S2 = remove_apps(S1, [AppName]), + {ok, XApp, S2} + end. + +%% -> {ok, OldXMod, NewState} | throw(Error) +do_remove_module(S, Module) -> + case dict:find(Module, S#xref.modules) of + error -> + throw_error({no_such_module, Module}); + {ok, XMod} -> + S1 = take_down(S), + {ok, XMod, remove_modules(S1, [Module])} + end. + +remove_rel(S, RelName) -> + Rels = [RelName], + Fun = fun({A,XApp}, L) when XApp#xref_app.rel_name =:= Rels -> + [A | L]; + (_, L) -> L + end, + Apps = foldl(Fun, [], dict:to_list(S#xref.applications)), + S1 = remove_apps(S, Apps), + NewReleases = remove_erase(Rels, S1#xref.releases), + S1#xref{releases = NewReleases}. + +remove_apps(S, Apps) -> + Fun = fun({M,XMod}, L) -> + case XMod#xref_mod.app_name of + [] -> L; + [AppName] -> [{AppName,M} | L] + end + end, + Ms = foldl(Fun, [], dict:to_list(S#xref.modules)), + Modules = to_external(image(relation(Ms), set(Apps))), + S1 = remove_modules(S, Modules), + NewApplications = remove_erase(Apps, S1#xref.applications), + S1#xref{applications = NewApplications}. + +remove_modules(S, Modules) -> + NewModules = remove_erase(Modules, S#xref.modules), + S#xref{modules = NewModules}. + +remove_erase([K | Ks], D) -> + remove_erase(Ks, dict:erase(K, D)); +remove_erase([], D) -> + D. + +do_add_libraries(Path, Verbose, State) -> + message(Verbose, lib_search, []), + {C, E} = xref_utils:list_path(Path, [?Suffix]), + message(Verbose, done, []), + MDs = to_external(relation_to_family(relation(C))), + %% message(Verbose, lib_check, []), + Reply = check_file(MDs, [], E, Path, State), + %% message(Verbose, done, []), + Reply. + +%%check_file([{_M, [{_N, Dir, File} | _]} | MDs], L, E, Path, State) -> +%% case beam_lib:version(filename:join(Dir, File)) of +%% {ok, {Module, _Version}} -> +%% XLib = #xref_lib{name = Module, dir = Dir}, +%% check_file(MDs, [{Module,XLib} | L], E, Path, State); +%% Error -> +%% check_file(MDs, L, [Error | E], Path, State) +%% end; +check_file([{Module, [{_N, Dir, _File} | _]} | MDs], L, E, Path, State) -> + XLib = #xref_lib{name = Module, dir = Dir}, + check_file(MDs, [{Module,XLib} | L], E, Path, State); +check_file([], L, [], Path, State) -> + D = dict:from_list(L), + State1 = State#xref{library_path = Path, libraries = D}, + %% Take down everything, that's simplest. + NewState = take_down(State1), + {ok, NewState}; +check_file([], _L, [E | _], _Path, _State) -> + E. + +%% -> {ok, NewState} | Error +%% Finding libraries may fail. +do_set_up(S, _VerboseOpt) when S#xref.variables =/= not_set_up -> + {ok, S}; +do_set_up(S, VerboseOpt) -> + message(VerboseOpt, set_up, []), + Reply = (catch do_set_up(S)), + message(VerboseOpt, done, []), + Reply. + +%% If data has been supplied using add_module/9 (and that is the only +%% sanctioned way), then DefAt, L, X, LCallAt, XCallAt, CallAt, XC, LC, +%% and LU are guaranteed to be functions (with all supplied +%% modules as domain (disregarding unknown modules, that is, modules +%% not supplied but hosting unknown functions)). +%% As a consequence, V and E are also functions. V is defined for unknown +%% modules also. +%% UU is also a function (thanks to sofs:family_difference/2...). +%% XU on the other hand can be a partial function (that is, not defined +%% for all modules). U is derived from XU, so U is also partial. +%% The inverse variables - LC_1, XC_1, E_1 and EE_1 - are all partial. +%% B is also partial. +do_set_up(S) when S#xref.mode =:= functions -> + ModDictList = dict:to_list(S#xref.modules), + [DefAt0, L, X0, LCallAt, XCallAt, CallAt, LC, XC, LU, + EE0, ECallAt, UC, LPredefined, + Mod_DF,Mod_DF_1,Mod_DF_2,Mod_DF_3] = make_families(ModDictList, 18), + + {XC_1, XU, XPredefined} = do_set_up_1(XC), + LC_1 = user_family(union_of_family(LC)), + E_1 = family_union(XC_1, LC_1), + Predefined = family_union(XPredefined, LPredefined), + + %% Add "hidden" functions to the exports. + X1 = family_union(X0, Predefined), + + F1 = family_union(L, X1), + V = family_union(F1, XU), + E = family_union(LC, XC), + + M = domain(V), + M2A = make_M2A(ModDictList), + {A2R,A} = make_A2R(S#xref.applications), + R = set(dict:fetch_keys(S#xref.releases)), + + %% Converting from edges of functions to edges of modules. + VEs = union_of_family(E), + Fun = {external, fun({{M1,_F1,_A1},{M2,_F2,_A2}}) -> {M1,M2} end}, + ME = projection(Fun, VEs), + ME2AE = multiple_relative_product({M2A, M2A}, ME), + + AE = range(ME2AE), + AE2RE = multiple_relative_product({A2R, A2R}, AE), + RE = range(AE2RE), + + AM = domain(F1), + %% Undef is the union of U0 and Lib: + {Undef, U0, Lib, Lib_DF, Lib_DF_1, Lib_DF_2, Lib_DF_3} = + make_libs(XU, F1, AM, S#xref.library_path, S#xref.libraries), + {B, U} = make_builtins(U0), + X1_B = family_union(X1, B), + F = family_union(F1, Lib), + DF = family_union(family_intersection(Mod_DF, X1_B), Lib_DF), + DF_1 = family_union(family_intersection(Mod_DF_1, X1_B), Lib_DF_1), + DF_2 = family_union(family_intersection(Mod_DF_2, X1_B), Lib_DF_2), + DF_3 = family_union(family_intersection(Mod_DF_3, X1_B), Lib_DF_3), + % If we have 'used' too, then there will be a set LU U XU... + UU = family_difference(family_difference(F1, LU), XU), + DefAt = make_defat(Undef, DefAt0), + + LM = domain(Lib), + UM = difference(difference(domain(U), AM), LM), + X = family_union(X1, Lib), + + %% Inter Call Graph. Calls to exported functions (library + %% functions inclusive) as well as calls within modules. This is a + %% way to discard calls to local functions in other modules. + EE_conv = converse(union_of_family(EE0)), + EE_exported = restriction(EE_conv, union_of_family(X)), + EE_local = + specification({external, fun({{M1,_,_},{M2,_,_}}) -> M1 =:= M2 end}, + EE_conv), + EE_0 = converse(union(EE_local, EE_exported)), + EE_1 = user_family(EE_0), + EE1 = partition_family({external, fun({{M1,_,_}, _MFA2}) -> M1 end}, + EE_0), + %% Make sure EE is defined for all modules: + EE = family_union(family_difference(EE0, EE0), EE1), + IFun = + fun({Mod,EE_M}, XMods) -> + IMFun = + fun(XrefMod) -> + [NoCalls, NoFunctionCalls, + NoFunctions, _NoInter] = XrefMod#xref_mod.info, + NewInfo = [NoCalls, NoFunctionCalls, NoFunctions, + {no_inter_function_calls,length(EE_M)}], + XrefMod#xref_mod{info = NewInfo} + end, + dict:update(Mod, IMFun,XMods) + end, + XrefMods1 = foldl(IFun, S#xref.modules, to_external(EE)), + S1 = S#xref{modules = XrefMods1}, + + UC_1 = user_family(union_of_family(UC)), + + ?FORMAT("DefAt ~p~n", [DefAt]), + ?FORMAT("U=~p~nLib=~p~nB=~p~nLU=~p~nXU=~p~nUU=~p~n", [U,Lib,B,LU,XU,UU]), + ?FORMAT("E_1=~p~nLC_1=~p~nXC_1=~p~n", [E_1,LC_1,XC_1]), + ?FORMAT("EE=~p~nEE_1=~p~nECallAt=~p~n", [EE, EE_1, ECallAt]), + ?FORMAT("DF=~p~nDF_1=~p~nDF_2=~p~nDF_3=~p~n", [DF, DF_1, DF_2, DF_3]), + + Vs = [{'L',L}, {'X',X},{'F',F},{'U',U},{'B',B},{'UU',UU}, + {'XU',XU},{'LU',LU},{'V',V},{v,V}, + {'LC',{LC,LC_1}},{'XC',{XC,XC_1}},{'E',{E,E_1}},{e,{E,E_1}}, + {'EE',{EE,EE_1}},{'UC',{UC,UC_1}}, + {'M',M},{'A',A},{'R',R}, + {'AM',AM},{'UM',UM},{'LM',LM}, + {'ME',ME},{'AE',AE},{'RE',RE}, + {'DF',DF},{'DF_1',DF_1},{'DF_2',DF_2},{'DF_3',DF_3}, + {me2ae, ME2AE},{ae, AE2RE},{m2a, M2A},{a2r, A2R}, + {def_at, DefAt}, {call_at, CallAt}, {e_call_at, ECallAt}, + {l_call_at, LCallAt}, {x_call_at, XCallAt}], + finish_set_up(S1, Vs); +do_set_up(S) when S#xref.mode =:= modules -> + ModDictList = dict:to_list(S#xref.modules), + [X0, I0, Mod_DF, Mod_DF_1, Mod_DF_2, Mod_DF_3] = + make_families(ModDictList, 7), + I = union_of_family(I0), + AM = domain(X0), + + {XU, Predefined} = make_predefined(I, AM), + %% Add "hidden" functions to the exports. + X1 = family_union(X0, Predefined), + V = family_union(X1, XU), + + M = union(AM, domain(XU)), + M2A = make_M2A(ModDictList), + {A2R,A} = make_A2R(S#xref.applications), + R = set(dict:fetch_keys(S#xref.releases)), + + ME = projection({external, fun({M1,{M2,_F2,_A2}}) -> {M1,M2} end}, + family_to_relation(I0)), + ME2AE = multiple_relative_product({M2A, M2A}, ME), + + AE = range(ME2AE), + AE2RE = multiple_relative_product({A2R, A2R}, AE), + RE = range(AE2RE), + + %% Undef is the union of U0 and Lib: + {_Undef, U0, Lib, Lib_DF, Lib_DF_1, Lib_DF_2, Lib_DF_3} = + make_libs(XU, X1, AM, S#xref.library_path, S#xref.libraries), + {B, U} = make_builtins(U0), + X1_B = family_union(X1, B), + DF = family_union(family_intersection(Mod_DF, X1_B), Lib_DF), + DF_1 = family_union(family_intersection(Mod_DF_1, X1_B), Lib_DF_1), + DF_2 = family_union(family_intersection(Mod_DF_2, X1_B), Lib_DF_2), + DF_3 = family_union(family_intersection(Mod_DF_3, X1_B), Lib_DF_3), + + LM = domain(Lib), + UM = difference(difference(domain(U), AM), LM), + X = family_union(X1, Lib), + + Empty = empty_set(), + Vs = [{'X',X},{'U',U},{'B',B},{'XU',XU},{v,V}, + {e,{Empty,Empty}}, + {'M',M},{'A',A},{'R',R}, + {'AM',AM},{'UM',UM},{'LM',LM}, + {'ME',ME},{'AE',AE},{'RE',RE}, + {'DF',DF},{'DF_1',DF_1},{'DF_2',DF_2},{'DF_3',DF_3}, + {me2ae, ME2AE},{ae, AE2RE},{m2a, M2A},{a2r, A2R}, + {def_at, Empty}, {call_at, Empty}, {e_call_at, Empty}, + {l_call_at, Empty}, {x_call_at, Empty}], + finish_set_up(S, Vs). + +finish_set_up(S, Vs) -> + T = do_finish_set_up(Vs, dict:new()), + S1 = S#xref{variables = T}, + %% io:format("~p <= state <= ~p~n", [pack:lsize(S), pack:usize(S)]), + {ok, S1}. + +do_finish_set_up([{Key, Value} | Vs], T) -> + {Type, OType} = var_type(Key), + Val = #xref_var{name = Key, value = Value, vtype = predef, + otype = OType, type = Type}, + T1 = dict:store(Key, Val, T), + do_finish_set_up(Vs, T1); +do_finish_set_up([], T) -> + T. + +var_type('B') -> {function, vertex}; +var_type('F') -> {function, vertex}; +var_type('L') -> {function, vertex}; +var_type('LU') -> {function, vertex}; +var_type('U') -> {function, vertex}; +var_type('UU') -> {function, vertex}; +var_type('V') -> {function, vertex}; +var_type('X') -> {function, vertex}; +var_type('XU') -> {function, vertex}; +var_type('DF') -> {function, vertex}; +var_type('DF_1') -> {function, vertex}; +var_type('DF_2') -> {function, vertex}; +var_type('DF_3') -> {function, vertex}; +var_type('A') -> {application, vertex}; +var_type('AM') -> {module, vertex}; +var_type('LM') -> {module, vertex}; +var_type('M') -> {module, vertex}; +var_type('UM') -> {module, vertex}; +var_type('R') -> {release, vertex}; +var_type('E') -> {function, edge}; +var_type('EE') -> {function, edge}; +var_type('LC') -> {function, edge}; +var_type('UC') -> {function, edge}; +var_type('XC') -> {function, edge}; +var_type('AE') -> {application, edge}; +var_type('ME') -> {module, edge}; +var_type('RE') -> {release, edge}; +var_type(_) -> {foo, bar}. + +make_families(ModDictList, N) -> + Fun1 = fun({_,XMod}) -> XMod#xref_mod.data end, + Ss = from_sets(map(Fun1, ModDictList)), + %% io:format("~n~p <= module data <= ~p~n", + %% [pack:lsize(Ss), pack:usize(Ss)]), + make_fams(N, Ss, []). + +make_fams(1, _Ss, L) -> + L; +make_fams(I, Ss, L) -> + Fun = {external, fun(R) -> {element(1, R), element(I, R)} end}, + make_fams(I-1, Ss, [projection(Fun, Ss) | L]). + +make_M2A(ModDictList) -> + Fun = fun({M,XMod}) -> {M, XMod#xref_mod.app_name} end, + Mod0 = family(map(Fun, ModDictList)), + Mod = family_to_relation(Mod0), + Mod. + +make_A2R(ApplDict) -> + AppDict = dict:to_list(ApplDict), + Fun = fun({A,XApp}) -> {A, XApp#xref_app.rel_name} end, + Appl0 = family(map(Fun, AppDict)), + AllApps = domain(Appl0), + Appl = family_to_relation(Appl0), + {Appl, AllApps}. + +do_set_up_1(XC) -> + %% Call Graph cross reference... + XCp = union_of_family(XC), + XC_1 = user_family(XCp), + + %% I - functions used externally from some module + %% XU - functions used externally per module. + I = range(XCp), + + {XU, XPredefined} = make_predefined(I, domain(XC)), + {XC_1, XU, XPredefined}. + +make_predefined(I, CallingModules) -> + XPredefined0 = predefined_funs(I), + XPredefined1 = converse(substitution(1, XPredefined0)), + %% predefined funs in undefined modules are still undefined... + XPredefined2 = restriction(XPredefined1, CallingModules), + XPredefined = relation_to_family(XPredefined2), + XU = partition_family(1, I), + {XU, XPredefined}. + +predefined_funs(Functions) -> + specification({external, predef_fun()}, Functions). + +predef_fun() -> + PredefinedFuns = xref_utils:predefined_functions(), + fun({_M,F,A}) -> member({F,A}, PredefinedFuns) end. + +make_defat(Undef, DefAt0) -> + % Complete DefAt with unknown functions: + Zero = from_term(0), + DAL = family_projection(fun(S) -> constant_function(S, Zero) end, Undef), + family_union(DefAt0, DAL). + +%% -> {Unknown U Lib, Unknown, Lib} | throw(Error) +make_libs(XU, F, AM, LibPath, LibDict) -> + Undef = family_difference(XU, F), + UM = difference(domain(family_to_relation(Undef)), AM), + Fs = case is_empty_set(UM) of + true -> + []; + false when LibPath =:= code_path -> + BFun = fun(M, A) -> case xref_utils:find_beam(M) of + {ok, File} -> [File | A]; + _ -> A + end + end, + foldl(BFun, [], to_external(UM)); + false -> + Libraries = dict:to_list(LibDict), + Lb = restriction(a_function(Libraries), UM), + MFun = fun({M,XLib}) -> + #xref_lib{dir = Dir} = XLib, + xref_utils:module_filename(Dir, M) + end, + map(MFun, to_external(Lb)) + end, + Fun = fun(FileName, Deprs) -> + case beam_lib:chunks(FileName, [exports, attributes]) of + {ok, {M, [{exports,X}, {attributes,A}]}} -> + Exports = mfa_exports(X, A, M), + %% No warnings for bad attributes... + {Deprecated,_Bad} = deprecated(A, Exports, M), + {{M,Exports}, [{M,Deprecated} | Deprs]}; + Error -> + throw(Error) + end + end, + {XL, DL} = mapfoldl(Fun, [], Fs), + LF = from_term(XL), + %% Undef is the first argument to make sure that the whole of LF + %% becomes garbage: + Lib = family_intersection(Undef, LF), + {B,_} = make_builtins(Undef), + DLib = family_union(Lib, B), + [DF_1,DF_21,DF_31,DF1] = depr_lib(4, DL, DL, [], [], DLib), + DF_2 = family_union(DF_21, DF_1), + DF_3 = family_union(DF_31, DF_2), + DF = family_union(DF1, DF_3), + U = family_difference(Undef, Lib), + {Undef, U, Lib, DF, DF_1, DF_2, DF_3}. + +depr_lib(0, _, _, LL, [], _Lib) -> + LL; +depr_lib(I, [], DL, LL, L, Lib) -> + DT = family_intersection(Lib, from_term(L)), + depr_lib(I-1, DL, DL, [DT | LL], [], Lib); +depr_lib(I, [{M,D} | Ds], DL, LL, L, Lib) -> + depr_lib(I, Ds, DL, LL, [{M,element(I, D)} | L], Lib). + +make_builtins(U0) -> + Tmp = family_to_relation(U0), + Fun2 = {external, fun({_M,{M,F,A}}) -> xref_utils:is_builtin(M, F, A) end}, + B = relation_to_family(specification(Fun2, Tmp)), + U = family_difference(U0, B), + {B, U}. + +% Returns a family that may not be defined for all modules. +user_family(R) -> + partition_family({external, fun({_MFA1, {M2,_,_}}) -> M2 end}, R). + +do_variables(State) -> + Fun = fun({Name, #xref_var{vtype = user}}, {P,U}) -> + {P,[Name | U]}; + ({Name, #xref_var{vtype = predef}}, A={P,U}) -> + case atom_to_list(Name) of + [H|_] when H>= $a, H=<$z -> A; + _Else -> {[Name | P], U} + end; + ({{tmp, V}, _}, A) -> + io:format("Bug in ~p: temporary ~p~n", [?MODULE, V]), A; + (_V, A) -> A + end, + {U,P} = foldl(Fun, {[],[]}, dict:to_list(State#xref.variables)), + {sort(P), sort(U)}. + +%% Throws away the variables derived from raw data. +take_down(S) when S#xref.variables =:= not_set_up -> + S; +take_down(S) -> + S#xref{variables = not_set_up}. + +make_query(Format, Args) -> + flatten(io_lib:format(Format, Args)). + +set_defaults([O | Os], [[V] | Vs], State) -> + NewState = set_def(O, V, State), + set_defaults(Os, Vs, NewState); +set_defaults([], [], State) -> + State. + +set_def(builtins, Value, State) -> + State#xref{builtins_default = Value}; +set_def(recurse, Value, State) -> + State#xref{recurse_default = Value}; +set_def(verbose, Value, State) -> + State#xref{verbose_default = Value}; +set_def(warnings, Value, State) -> + State#xref{warnings_default = Value}. + +option_values([Option | Options], State) -> + Default = current_default(State, Option), + [{Option, [Default,true,false]} | option_values(Options, State)]; +option_values([], _State) -> + []. + +current_default(State, builtins) -> + State#xref.builtins_default; +current_default(State, recurse) -> + State#xref.recurse_default; +current_default(State, verbose) -> + State#xref.verbose_default; +current_default(State, warnings) -> + State#xref.warnings_default. + +%% sets are used here to avoid long execution times +do_info(S, modules) -> + D = sort(dict:to_list(S#xref.modules)), + map(fun({_M,XMod}) -> mod_info(XMod) end, D); +do_info(S, applications) -> + AppMods = to_external(relation_to_family(relation(app_mods(S)))), + Sum = sum_mods(S, AppMods), + map(fun(AppSum) -> app_info(AppSum, S) end, Sum); +do_info(S, releases) -> + {RA, RRA} = rel_apps(S), + rel_apps_sums(RA, RRA, S); +do_info(S, libraries) -> + D = sort(dict:to_list(S#xref.libraries)), + map(fun({_L,XLib}) -> lib_info(XLib) end, D); +do_info(_S, I) -> + error({no_such_info, I}). + +do_info(S, Type, E) when is_atom(E) -> + do_info(S, Type, [E]); +do_info(S, modules, Modules0) when is_list(Modules0) -> + Modules = to_external(set(Modules0)), + XMods = find_info(Modules, S#xref.modules, no_such_module), + map(fun(XMod) -> mod_info(XMod) end, XMods); +do_info(S, applications, Applications) when is_list(Applications) -> + _XA = find_info(Applications, S#xref.applications, no_such_application), + AM = relation(app_mods(S)), + App = set(Applications), + AppMods_S = relation_to_family(restriction(AM, App)), + AppSums = sum_mods(S, to_external(AppMods_S)), + map(fun(AppSum) -> app_info(AppSum, S) end, AppSums); +do_info(S, releases, Releases) when is_list(Releases) -> + _XR = find_info(Releases, S#xref.releases, no_such_release), + {AR, RRA} = rel_apps(S), + AR_S = restriction(2, relation(AR), set(Releases)), + rel_apps_sums(to_external(AR_S), RRA, S); +do_info(S, libraries, Libraries0) when is_list(Libraries0) -> + Libraries = to_external(set(Libraries0)), + XLibs = find_info(Libraries, S#xref.libraries, no_such_library), + map(fun(XLib) -> lib_info(XLib) end, XLibs); +do_info(_S, I, J) when is_list(J) -> + throw_error({no_such_info, I}). + +find_info([E | Es], Dict, Error) -> + case dict:find(E, Dict) of + error -> + throw_error({Error, E}); + {ok, X} -> + [X | find_info(Es, Dict, Error)] + end; +find_info([], _Dict, _Error) -> + []. + +%% -> {[{AppName, RelName}], [{RelName, XApp}]} +rel_apps(S) -> + D = sort(dict:to_list(S#xref.applications)), + Fun = fun({_A, XApp}, Acc={AR, RRA}) -> + case XApp#xref_app.rel_name of + [] -> Acc; + [R] -> + AppName = XApp#xref_app.name, + {[{AppName, R} | AR], [{R, XApp} | RRA]} + end + end, + foldl(Fun, {[], []}, D). + +%% -> [{{RelName, [XApp]}, Sums}] +rel_apps_sums(AR, RRA0, S) -> + AppMods = app_mods(S), % [{AppName, XMod}] + RRA1 = relation_to_family(relation(RRA0)), + RRA = inverse(substitution(1, RRA1)), + %% RRA is [{RelName,{RelName,[XApp]}}] + RelMods = relative_product1(relation(AR), relation(AppMods)), + RelAppsMods = relative_product1(RRA, RelMods), + RelsAppsMods = to_external(relation_to_family(RelAppsMods)), + %% [{{RelName, [XApp]}, [XMod]}] + Sum = sum_mods(S, RelsAppsMods), + map(fun(RelAppsSums) -> rel_info(RelAppsSums, S) end, Sum). + +%% -> [{AppName, XMod}] +app_mods(S) -> + D = sort(dict:to_list(S#xref.modules)), + Fun = fun({_M,XMod}, Acc) -> + case XMod#xref_mod.app_name of + [] -> Acc; + [AppName] -> [{AppName, XMod} | Acc] + end + end, + foldl(Fun, [], D). + +mod_info(XMod) -> + #xref_mod{name = M, app_name = AppName, builtins = BuiltIns, + dir = Dir, info = Info} = XMod, + App = sup_info(AppName), + {M, [{application, App}, {builtins, BuiltIns}, {directory, Dir} | Info]}. + +app_info({AppName, ModSums}, S) -> + XApp = dict:fetch(AppName, S#xref.applications), + #xref_app{rel_name = RelName, vsn = Vsn, dir = Dir} = XApp, + Release = sup_info(RelName), + {AppName, [{directory,Dir}, {release, Release}, {version,Vsn} | ModSums]}. + +rel_info({{RelName, XApps}, ModSums}, S) -> + NoApps = length(XApps), + XRel = dict:fetch(RelName, S#xref.releases), + Dir = XRel#xref_rel.dir, + {RelName, [{directory, Dir}, {no_applications, NoApps} | ModSums]}. + +lib_info(XLib) -> + #xref_lib{name = LibName, dir = Dir} = XLib, + {LibName, [{directory,Dir}]}. + +sup_info([]) -> []; +sup_info([Name]) -> + [Name]. + +sum_mods(S, AppsMods) -> + sum_mods(S, AppsMods, []). + +sum_mods(S, [{N, XMods} | NX], L) -> + sum_mods(S, NX, [{N, no_sum(S, XMods)} | L]); +sum_mods(_S, [], L) -> + reverse(L). + +no_sum(S, L) when S#xref.mode =:= functions -> + no_sum(L, 0, 0, 0, 0, 0, 0, 0, 0, length(L)); +no_sum(S, L) when S#xref.mode =:= modules -> + [{no_analyzed_modules, length(L)}]. + +no_sum([XMod | D], C0, UC0, LC0, XC0, UFC0, L0, X0, EV0, NoM) -> + [{no_calls, {C,UC}}, + {no_function_calls, {LC,XC,UFC}}, + {no_functions, {L,X}}, + {no_inter_function_calls, EV}] = XMod#xref_mod.info, + no_sum(D, C0+C, UC0+UC, LC0+LC, XC0+XC, UFC0+UFC, L0+L, X0+X, EV0+EV, NoM); +no_sum([], C, UC, LC, XC, UFC, L, X, EV, NoM) -> + [{no_analyzed_modules, NoM}, + {no_calls, {C,UC}}, + {no_function_calls, {LC,XC,UFC}}, + {no_functions, {L,X}}, + {no_inter_function_calls, EV}]. + +%% -> ok | throw(Error) +is_filename(F) when is_atom(F) -> + ok; +is_filename(F) -> + case xref_utils:is_string(F, 31) of + true -> + ok; + false -> + throw_error({invalid_filename, F}) + end. + +module_file(XMod) -> + xref_utils:module_filename(XMod#xref_mod.dir, XMod#xref_mod.name). + +warnings(_Flag, _Message, []) -> true; +warnings(Flag, Message, [F | Fs]) -> + message(Flag, Message, F), + warnings(Flag, Message, Fs). + +%% pack(term()) -> term() +%% +%% The identify function. The returned term does not use more heap +%% than the given term. Tuples that are equal (=:=/2) are made +%% "the same". +%% +%% The process dictionary is used because it seems to be faster than +%% anything else right now... +%% +%pack(T) -> T; +pack(T) -> + PD = erase(), + NT = pack1(T), + %% true = T =:= NT, + %% io:format("erasing ~p elements...~n", [length(erase())]), + erase(), % wasting heap (and time)... + map(fun({K,V}) -> put(K, V) end, PD), + NT. + +pack1(C) when not is_tuple(C), not is_list(C) -> + C; +pack1([T | Ts]) -> + %% don't store conscells... + [pack1(T) | pack1(Ts)]; +%% Optimization. +pack1(T={Mod,Fun,_}) when is_atom(Mod), is_atom(Fun) -> % MFA + case get(T) of + undefined -> put(T, T), T; + NT -> NT + end; +pack1({C, L}) when is_list(L) -> % CallAt + {pack1(C), L}; +pack1({MFA, L}) when is_integer(L) -> % DefAt + {pack1(MFA), L}; +%% End optimization. +pack1([]) -> + []; +pack1(T) -> % when is_tuple(T) + case get(T) of + undefined -> + NT = tpack(T, tuple_size(T), []), + put(NT, NT), + NT; + NT -> + NT + end. + +tpack(_T, 0, L) -> + list_to_tuple(L); +tpack(T, I, L) -> + tpack(T, I-1, [pack1(element(I, T)) | L]). + +message(true, What, Arg) -> + case What of + reading_beam -> + io:format("~s... ", Arg); + skipped_beam -> + io:format("skipped (no debug information)~n", Arg); + no_debug_info -> + io:format("Skipping ~s (no debug information)~n", Arg); + unresolved_summary1 -> + io:format("~p: 1 unresolved call~n", Arg); + unresolved_summary -> + io:format("~p: ~p unresolved calls~n", Arg); + jam -> + io:format("Skipping ~s (probably JAM file)~n", [Arg]); + unreadable -> + io:format("Skipping ~s (unreadable)~n", [Arg]); + xref_attr -> + io:format("~s: Skipping 'xref' attribute ~w~n", Arg); + depr_attr -> + io:format("~s: Skipping 'deprecated' attribute ~w~n", Arg); + lib_search -> + io:format("Scanning library path for BEAM files... ", []); + lib_check -> + io:format("Checking library files... ", []); + set_up -> + io:format("Setting up...", Arg); + done -> + io:format("done~n", Arg); + error -> + io:format("error~n", Arg); + Else -> + io:format("~p~n", [{Else,Arg}]) + end; +message(_, _, _) -> + true. + +throw_error(Reason) -> + throw(error(Reason)). + +error(Reason) -> + {error, ?MODULE, Reason}. diff --git a/lib/tools/src/xref_compiler.erl b/lib/tools/src/xref_compiler.erl new file mode 100644 index 0000000000..67ac8c617d --- /dev/null +++ b/lib/tools/src/xref_compiler.erl @@ -0,0 +1,928 @@ +%% +%% %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(xref_compiler). + +-include("xref.hrl"). + +%-define(debug, true). + +-ifdef(debug). +-define(FORMAT(P, A), io:format(P, A)). +-define(CALL(F), F). +-else. +-define(FORMAT(P, A), ok). +-define(CALL(F), ok). +-endif. + +-export([compile/2]). + +-export([update_graph_counter/3]). + +-export([format_error/1]). + +-import(lists, + [concat/1, foldl/3, nthtail/2, reverse/1, sort/1, sublist/2]). + +-import(sofs, + [composite/2, difference/2, empty_set/0, from_term/1, + intersection/2, is_empty_set/1, multiple_relative_product/2, + projection/2, relation/1, relation_to_family/1, + restriction/2, substitution/2, to_external/1, union/2, + union_of_family/1]). + +%% +%% Exported functions +%% + +compile(Chars, Table) -> + case xref_scanner:scan(Chars) of + {ok, Tokens} -> + case xref_parser:parse(Tokens) of + {ok, ParseTree} -> + ?FORMAT("ParseTree ~p~n", [ParseTree]), + case catch statements(ParseTree, Table) of + E={error, _, _} -> + E; + {ok, UV, P} -> + %% User variables to be. + Table1 = user_vars(UV, Table), + ?CALL(statistics(runtime)), + Reply = i(P, Table1), + ?CALL({_, Time} = statistics(runtime)), + ?FORMAT("Result in ~p ms~n",[Time]), + Reply + end; + {error, {Line, _Module, Error}} -> + error({parse_error, Line, Error}) + end; + {error, Info, Line} -> + error({parse_error, Line, Info}) + end. + +format_error({error, Module, Error}) -> + Module:format_error(Error); +format_error({parse_error, Line, Error}) -> + format_parse_error(Error, format_line(Line)); +format_error({variable_reassigned, Expr}) -> + io_lib:format("Variable assigned more than once: ~s~n", [Expr]); +format_error({unknown_variable, Name}) -> + io_lib:format("Variable ~p used before set~n", [Name]); +format_error({type_error, Expr}) -> + io_lib:format("Operator applied to argument(s) of different or " + "invalid type(s): ~s~n", [Expr]); +format_error({type_mismatch, Expr1, Expr2}) -> + io_lib:format("Constants of different types: ~s, ~s~n", + [Expr1, Expr2]); +format_error({unknown_constant, Constant}) -> + io_lib:format("Unknown constant ~s~n", [Constant]); +format_error(E) -> + io_lib:format("~p~n", [E]). + +%% +%% Local functions +%% + +user_vars([{{user,Name}, Val} | UV], Table) -> + user_vars(UV, dict:store(Name, Val, Table)); +user_vars([_V | UV], Table) -> + user_vars(UV, Table); +user_vars([], Table) -> + Table. + +statements(Stmts, Table) -> + statements(Stmts, Table, [], []). + +statements([Stmt={assign, VarType, Name, E} | Stmts0], Table, L, UV) -> + case dict:find(Name, Table) of + {ok, _} -> + throw_error({variable_reassigned, xref_parser:t2s(Stmt)}); + error -> + {Type, OType, NewE} = t_expr(E, Table), + Val = #xref_var{name = Name, vtype = VarType, + otype = OType, type = Type}, + NewTable = dict:store(Name, Val, Table), + Stmts = if Stmts0 =:= [] -> [{variable, Name}]; true -> Stmts0 end, + Variable = {VarType, Name}, + Put = {put, Variable, NewE}, + statements(Stmts, NewTable, [Put | L], [{Variable,Val} | UV]) + end; +statements([Expr], Table, L, UV) -> + {Type, OType, NewE} = t_expr(Expr, Table), + E1 = un_familiarize(Type, OType, NewE), + NE = case {Type, OType} of + %% Edges with empty sets of line numbers are removed. + {{line, _}, edge} -> + {relation_to_family, E1}; + {_Type, edge_closure} -> + %% Fake a closure usage, just to make sure it is destroyed. + E2 = {fun graph_access/2, E1, E1}, + {fun(_E) -> 'closure()' end, E2}; + _Else -> E1 + end, + {ok, UV, stats(L, NE)}. + +stats([{put, V, X} | Ss], E) -> + stats(Ss, {put, V, X, E}); +stats([], E) -> + E. + +t_expr(E, Table) -> + {expr, Type, OType, E1} = check_expr(E, Table), + ?FORMAT("TExpr:~n~p~n",[E1]), + E2 = convert(E1), + ?FORMAT("After conversion:~n~p~n",[E2]), + {Type, OType, E2}. + +%%% check_expr/2 translates Expr in xref_parser.yrl into TExpr: +%%% +%%% TExpr = {expr, Type, ObjectType, Expr} +%%% Expr = {constants, [Constant]} +%%% | {variable, {VarType, VarName}} +%%% | {call, Call, Expr} +%%% | {call, Call, Expr, Expr} +%%% | {call, restriction, integer(), Expr, Expr} +%%% | {convert, ObjectType, Type, Type} +%%% | {convert, Type, Type} +%%% Constant = atom() | {atom(), atom()} | MFA | {MFA, MFA} +%%% Call = atom() % function in the sofs module +%%% | fun() +%%% Type = {line, LineType} | function | module | application | release +%%% | number +%%% LineType = line | local_call | external_call | export_call | all_line_call +%%% VarType = predef | user | tmp +%%% ObjectType = vertex | vertex_set | edge | edge_set | edge_closure | path +%%% | number +%%% MFA = {atom(), atom(), integer()} + +%% -> TExpr +check_expr({list, L}, Table) -> + check_constants(L, Table); +check_expr({tuple, L}, Table) -> + {expr, Type, vertex, _Consts} = check_constants(L, Table), + Cs = reverse(constant_vertices(L, [])), + {expr, Type, path, {constants, Cs}}; +check_expr({variable, Name}, Table) -> + case dict:find(Name, Table) of + {ok, #xref_var{vtype = VarType, otype = OType, type = Type}} -> + V0 = {variable, {VarType, Name}}, + V = case {VarType, Type, OType} of + {predef, release, _} -> V0; + {predef, application, _} -> V0; + {predef, module, _} -> V0; + {predef, function, vertex} -> V0; + {predef, function, edge} -> {call, union_of_family, V0}; + _Else -> V0 + end, + {expr, Type, OType, V}; + error -> + throw_error({unknown_variable, Name}) + end; +check_expr({type, {type, _Type}, E}, Table) -> + check_expr(E, Table); +check_expr(Expr={type, {convert, NewType0}, E}, Table) -> + NewType = what_type(NewType0), + {expr, OldType, OType, NE} = check_expr(E, Table), + ok = check_conversion(OType, OldType, NewType, Expr), + {expr, NewType, OType, {convert, OType, OldType, NewType, NE}}; +check_expr(Expr={set, SOp, E}, Table) -> + {expr, Type, OType0, E1} = check_expr(E, Table), + OType = case {OType0, SOp} of + {edge, range} -> vertex; + {edge, domain} -> vertex; + {edge, weak} -> edge; + {edge, strict} -> edge; + {edge_set, range} -> vertex_set; + {edge_set, domain} -> vertex_set; + {edge_set, weak} -> edge_set; + {edge_set, strict} -> edge_set; + _ -> + throw_error({type_error, xref_parser:t2s(Expr)}) + end, + Op = set_op(SOp), + NE = function_vertices_to_family(Type, OType, {call, Op, E1}), + {expr, Type, OType, NE}; +check_expr(Expr={graph, Op, E}, Table) -> + {expr, Type, NOType, E1} = check_expr(E, Table), + case Type of + {line, _LineType} -> + throw_error({type_error, xref_parser:t2s(Expr)}); + _Else -> + ok + end, + OType = + case {NOType, Op} of + {edge, components} -> vertex_set; + {edge, condensation} -> edge_set; + {edge, closure} -> edge_closure; + {edge_closure, components} -> vertex_set; + {edge_closure, condensation} -> edge_set; + {edge_closure, closure} -> edge_closure; + %% Neither need nor want these ones: + %% {edge_set, closure} -> edge_set_closure; + %% {edge_set, components} -> vertex_set_set; + _ -> + throw_error({type_error, xref_parser:t2s(Expr)}) + end, + E2 = {convert, NOType, edge_closure, E1}, + NE = case Op of + closure -> E2; + _Op -> use_of_closure(Op, E2) + end, + {expr, Type, OType, NE}; +check_expr(Expr={numeric, '#', E}, Table) -> + {expr, Type, OType, E1} = check_expr(E, Table), + case OType of + vertex -> ok; + vertex_set -> ok; + edge -> ok; + edge_set -> ok; + _Else -> throw_error({type_error, xref_parser:t2s(Expr)}) + end, + NE = {convert, OType, Type, number, E1}, + {expr, number, number, {call, no_elements, NE}}; +check_expr(Expr={set, SOp, E1, E2}, Table) -> + %% sets and numbers... + {expr, Type1, OType1, NE1} = check_expr(E1, Table), + {expr, Type2, OType2, NE2} = check_expr(E2, Table), + OType = case {OType1, OType2} of + {vertex, vertex} -> vertex; + {edge, edge} -> edge; + {number, number} -> number; + _ -> throw_error({type_error, xref_parser:t2s(Expr)}) + end, + case OType of + number -> + {expr, number, number, {call, ari_op(SOp), NE1, NE2}}; + _Else -> % set + {Type, NewE1, NewE2} = + case {type_ord(Type1), type_ord(Type2)} of + {T1, T2} when T1 =:= T2 -> + %% Example: if Type1 = {line, line} and + %% Type2 = {line, export_line}, then this is not + %% correct, but works: + {Type1, NE1, NE2}; + {T1, T2} when T1 < 2; T2 < 2 -> + throw_error({type_error, xref_parser:t2s(Expr)}); + {T1, T2} when T1 > T2 -> + {Type2, {convert, OType, Type1, Type2, NE1}, NE2}; + {T1, T2} when T1 < T2 -> + {Type1, NE1, {convert, OType, Type2, Type1, NE2}} + end, + Op = set_op(SOp, Type, OType), + {expr, Type, OType, {call, Op, NewE1, NewE2}} + end; +check_expr(Expr={restr, ROp, E1, E2}, Table) -> + {expr, Type1, OType1, NE1} = check_expr(E1, Table), + {expr, Type2, OType2, NE2} = check_expr(E2, Table), + case {Type1, Type2} of + {{line, _LineType1}, _Type2} -> + throw_error({type_error, xref_parser:t2s(Expr)}); + {_Type1, {line, _LineType2}} -> + throw_error({type_error, xref_parser:t2s(Expr)}); + _ -> + ok + end, + case {OType1, OType2} of + {edge, vertex} when ROp =:= '|||' -> + {expr, _, _, R1} = restriction('|', E1, Type1, NE1, Type2, NE2), + {expr, _, _, R2} = restriction('||', E1, Type1, NE1, Type2, NE2), + {expr, Type1, edge, {call, intersection, R1, R2}}; + {edge, vertex} -> + restriction(ROp, E1, Type1, NE1, Type2, NE2); + {edge_closure, vertex} when ROp =:= '|||' -> + {expr, _, _, R1} = + closure_restriction('|', Type1, Type2, OType2, NE1, NE2), + {expr, _, _, R2} = + closure_restriction('||', Type1, Type2, OType2, NE1, NE2), + {expr, Type1, edge, {call, intersection, R1, R2}}; + {edge_closure, vertex} -> + closure_restriction(ROp, Type1, Type2, OType2, NE1, NE2); + _ -> + throw_error({type_error, xref_parser:t2s(Expr)}) + end; +check_expr(Expr={path, E1, E2}, Table) -> + {expr, Type1, OType1a, E1a} = check_expr(E1, Table), + {expr, Type2, OType2, E2a} = check_expr(E2, Table), + case {Type1, Type2} of + {{line, _LineType1}, _Type2} -> + throw_error({type_error, xref_parser:t2s(Expr)}); + {_Type1, {line, _LineType2}} -> + throw_error({type_error, xref_parser:t2s(Expr)}); + _Else -> + ok + end, + E2b = {convert, OType2, Type2, Type1, E2a}, + {OType1, NE1} = path_arg(OType1a, E1a), + NE2 = case {OType1, OType2} of + {path, edge} -> {convert, OType2, edge_closure, E2b}; + {path, edge_closure} when Type1 =:= Type2 -> E2b; + _ -> throw_error({type_error, xref_parser:t2s(Expr)}) + end, + {expr, Type1, path, use_of_closure(path, NE2, NE1)}; +check_expr({regexpr, RExpr, Type0}, _Table) -> + %% Using the "universal" variables is not optimal as regards speed, + %% but it is simple... + Type = what_type(Type0), + V = case Type of + function -> v; + module -> 'M'; + application -> 'A'; + release -> 'R' + end, + Var = {variable, {predef, V}}, + Call = {call, fun(E, V2) -> xref_utils:regexpr(E, V2) end, + {constants, RExpr}, Var}, + {expr, Type, vertex, Call}; +check_expr(C={constant, _Type, _OType, _C}, Table) -> + check_constants([C], Table). + +path_arg(edge, E={constants, C}) -> + case to_external(C) of + [{V1,V2}] -> {path, {constants, [V1, V2]}}; + _ -> {edge, E} + end; +path_arg(OType, E) -> + {OType, E}. + +check_conversion(OType, Type1, Type2, Expr) -> + case conversions(OType, Type1, Type2) of + ok -> ok; + not_ok -> throw_error({type_error, xref_parser:t2s(Expr)}) + end. + +%% Allowed conversions. +conversions(_OType, {line, LineType}, {line, LineType}) -> ok; +conversions(edge, {line, _}, {line, all_line_call}) -> ok; +conversions(edge, From, {line, Line}) + when is_atom(From), Line =/= all_line_call -> ok; +conversions(vertex, From, {line, line}) when is_atom(From) -> ok; +conversions(vertex, From, To) when is_atom(From), is_atom(To) -> ok; +conversions(edge, From, To) when is_atom(From), is_atom(To) -> ok; +%% "Extra": +conversions(edge, {line, Line}, To) + when is_atom(To), Line =/= all_line_call -> ok; +conversions(vertex, {line, line}, To) when is_atom(To) -> ok; +conversions(_OType, _From, _To) -> not_ok. + +set_op(union, {line, _LineType}, edge) -> family_union; +set_op(intersection, {line, _LineType}, edge) -> family_intersection; +set_op(difference, {line, _LineType}, edge) -> family_difference; +set_op(union, function, vertex) -> family_union; +set_op(intersection, function, vertex) -> family_intersection; +set_op(difference, function, vertex) -> family_difference; +set_op(SOp, _Type, _OType) -> SOp. + +set_op(weak) -> weak_relation; +set_op(strict) -> strict_relation; +set_op(Op) -> Op. + +ari_op(union) -> fun(X, Y) -> X + Y end; +ari_op(intersection) -> fun(X, Y) -> X * Y end; +ari_op(difference) -> fun(X, Y) -> X - Y end. + +restriction(ROp, E1, Type1, NE1, Type2, NE2) -> + {Column, _} = restr_op(ROp), + case NE1 of + {call, union_of_family, _E} when ROp =:= '|' -> + restriction(Column, Type1, E1, Type2, NE2); + {call, union_of_family, _E} when ROp =:= '||' -> + E1p = {inverse, E1}, + restriction(Column, Type1, E1p, Type2, NE2); + _ -> + NE2a = {convert, vertex, Type2, Type1, NE2}, + NE2b = family_to_function_vertices(Type1, vertex, NE2a), + {expr, Type1, edge, {call, restriction, Column, NE1, NE2b}} + end. + +restriction(Column, Type1, VE, Type2, E2) when Type1 =:= function -> + M = {convert, vertex, Type2, module, E2}, + Restr = {call, union_of_family, {call, restriction, VE, M}}, + C = {convert, vertex, Type2, Type1, E2}, + F = family_to_function_vertices(Type1, vertex, C), + {expr, Type1, edge, {call, restriction, Column, Restr, F}}. + +closure_restriction(Op, Type1, Type2, OType2, E1, E2) -> + {_, Fun} = restr_op(Op), + E2a = {convert, OType2, Type2, Type1, E2}, + E2b = family_to_function_vertices(Type1, vertex, E2a), + {expr, Type1, edge, use_of_closure(Fun, E1, E2b)}. + +restr_op('|') -> {1, call}; +restr_op('||') -> {2, use}. + +%% Closures (digraphs) must be deleted, but not too soon. A wrapper +%% is inserted here for every use of a closure, to make sure that a +%% 'save' and an 'unput' instruction are inserted for every digraph, in +%% particular the temporary ones. The 'unput' instruction must occur +%% _after_ the call to the function that uses the digraph (the default +%% is that it is inserted _before_ the call). +use_of_closure(Op, C) -> + access_of_closure(C, {call, fun(X) -> xref_utils:Op(X) end, C}). + +use_of_closure(Op, C, E) -> + access_of_closure(C, {call, fun(X, Y) -> xref_utils:Op(X, Y) end, C, E}). + +access_of_closure(C, E) -> + {call, fun graph_access/2, C, E}. + +check_constants(Cs=[C={constant, Type0, OType, _Con} | Cs1], Table) -> + check_mix(Cs1, Type0, OType, C), + Types = case Type0 of + unknown -> ['Rel', 'App', 'Mod']; + T -> [T] + end, + case split(Types, Cs, Table) of + [{TypeToBe, _Cs}] -> + S = from_term([Con || {constant, _T, _OT, Con} <- Cs]), + Type = what_type(TypeToBe), + E = function_vertices_to_family(Type, OType, {constants, S}), + {expr, Type, OType, E}; + [{Type1, [C1|_]}, {Type2, [C2|_]} | _] -> + throw_error({type_mismatch, + make_vertex(Type1, C1), + make_vertex(Type2, C2)}) + end. + +check_mix([C={constant, 'Fun', OType, _Con} | Cs], 'Fun', OType, _C0) -> + check_mix(Cs, 'Fun', OType, C); +check_mix([C={constant, Type, OType, _Con} | Cs], Type0, OType, _C0) + when Type =/= 'Fun', Type0 =/= 'Fun' -> + check_mix(Cs, Type, OType, C); +check_mix([C | _], _Type0, _OType0, C0) -> + throw_error({type_mismatch, xref_parser:t2s(C0), xref_parser:t2s(C)}); +check_mix([], _Type0, _OType0, _C0) -> + ok. + +split(Types, Cs, Table) -> + Vs = from_term(constant_vertices(Cs, [])), + split(Types, Vs, empty_set(), unknown, Table, []). + +split([Type | Types], Vs, AllSoFar, _Type, Table, L) -> + S0 = known_vertices(Type, Vs, Table), + S = difference(S0, AllSoFar), + case is_empty_set(S) of + true -> + split(Types, Vs, AllSoFar, Type, Table, L); + false -> + All = union(AllSoFar, S0), + split(Types, Vs, All, Type, Table, + [{Type, to_external(S)} | L]) + end; +split([], Vs, All, Type, _Table, L) -> + case to_external(difference(Vs, All)) of + [] -> L; + [C|_] -> throw_error({unknown_constant, make_vertex(Type, C)}) + end. + +make_vertex(Type, C) -> + xref_parser:t2s({constant, Type, vertex, C}). + +constant_vertices([{constant, _Type, edge, {A,B}} | Cs], L) -> + constant_vertices(Cs, [A, B | L]); +constant_vertices([{constant, _Type, vertex, V} | Cs], L) -> + constant_vertices(Cs, [V | L]); +constant_vertices([], L) -> + L. + +known_vertices('Fun', Cs, T) -> + M = projection(1, Cs), + F = union_of_family(restriction(fetch_value(v, T), M)), + intersection(Cs, F); +known_vertices('Mod', Cs, T) -> + intersection(Cs, fetch_value('M', T)); +known_vertices('App', Cs, T) -> + intersection(Cs, fetch_value('A', T)); +known_vertices('Rel', Cs, T) -> + intersection(Cs, fetch_value('R', T)). + +function_vertices_to_family(function, vertex, E) -> + {call, partition_family, 1, E}; +function_vertices_to_family(_Type, _OType, E) -> + E. + +family_to_function_vertices(function, vertex, E) -> + {call, union_of_family, E}; +family_to_function_vertices(_Type, _OType, E) -> + E. + +-define(Q(E), {quote, E}). + +convert({inverse, {variable, Variable}}) -> + {get, {inverse, var_name(Variable)}}; +convert({variable, Variable}) -> + {get, var_name(Variable)}; +convert({convert, FromOType, ToOType, E}) -> + convert(convert(E), FromOType, ToOType); +convert({convert, OType, FromType, ToType, E}) -> + convert(convert(E), OType, FromType, ToType); +convert({call, Op, E}) -> + {Op, convert(E)}; +convert({call, Op, E1, E2}) -> + {Op, convert(E1), convert(E2)}; +convert({call, Op, E1, E2, E3}) -> + {Op, convert(E1), convert(E2), convert(E3)}; +convert({constants, Constants}) -> + ?Q(Constants); +convert(I) when is_integer(I) -> + ?Q(I). + +var_name({predef, VarName}) -> VarName; +var_name(Variable) -> Variable. + +convert(E, OType, OType) -> + E; +convert(E, edge, edge_closure) -> + {fun(S) -> xref_utils:closure(S) end, E}. + +convert(E, OType, FromType, number) -> + un_familiarize(FromType, OType, E); +convert(E, OType, FromType, ToType) -> + case {type_ord(FromType), type_ord(ToType)} of + {FT, To} when FT =:= To -> + E; + {FT, ToT} when FT > ToT -> + special(OType, FromType, ToType, E); + {FT, ToT} when FT < ToT -> + general(OType, FromType, ToType, E) + end. + +-define(T(V), {tmp, V}). + +general(_ObjectType, FromType, ToType, X) when FromType =:= ToType -> + X; +general(edge, {line, _LineType}, ToType, LEs) -> + VEs = {projection, ?Q({external, fun({V1V2,_Ls}) -> V1V2 end}), LEs}, + general(edge, function, ToType, VEs); +general(edge, function, ToType, VEs) -> + MEs = {projection, + ?Q({external, fun({{M1,_,_},{M2,_,_}}) -> {M1,M2} end}), + VEs}, + general(edge, module, ToType, MEs); +general(edge, module, ToType, MEs) -> + AEs = {image, {get, me2ae}, MEs}, + general(edge, application, ToType, AEs); +general(edge, application, release, AEs) -> + {image, {get, ae}, AEs}; +general(vertex, {line, _LineType}, ToType, L) -> + V = {partition_family, ?Q(1), {domain, L}}, + general(vertex, function, ToType, V); +general(vertex, function, ToType, V) -> + M = {domain, V}, + general(vertex, module, ToType, M); +general(vertex, module, ToType, M) -> + A = {image, {get, m2a}, M}, + general(vertex, application, ToType, A); +general(vertex, application, release, A) -> + {image, {get, a2r}, A}. + +special(_ObjectType, FromType, ToType, X) when FromType =:= ToType -> + X; +special(edge, {line, _LineType}, {line, all_line_call}, Calls) -> + {put, ?T(mods), + {projection, + ?Q({external, fun({{{M1,_,_},{M2,_,_}},_}) -> {M1,M2} end}), + Calls}, + {put, ?T(def_at), + {union, {image, {get, def_at}, + {union, {domain, {get, ?T(mods)}}, + {range, {get, ?T(mods)}}}}}, + {fun funs_to_lines/2, + {get, ?T(def_at)}, Calls}}}; +special(edge, function, {line, LineType}, VEs) -> + Var = if + LineType =:= line -> call_at; + LineType =:= export_call -> e_call_at; + LineType =:= local_call -> l_call_at; + LineType =:= external_call -> x_call_at + end, + line_edges(VEs, Var); +special(edge, module, ToType, MEs) -> + VEs = {image, + {projection, + ?Q({external, fun(FE={{M1,_,_},{M2,_,_}}) -> {{M1,M2},FE} end}), + {union, + {image, {get, e}, + {projection, ?Q({external, fun({M1,_M2}) -> M1 end}), MEs}}}}, + MEs}, + special(edge, function, ToType, VEs); +special(edge, application, ToType, AEs) -> + MEs = {inverse_image, {get, me2ae}, AEs}, + special(edge, module, ToType, MEs); +special(edge, release, ToType, REs) -> + AEs = {inverse_image, {get, ae}, REs}, + special(edge, application, ToType, AEs); +special(vertex, function, {line, _LineType}, V) -> + {restriction, + {union_of_family, {restriction, {get, def_at}, {domain, V}}}, + {union_of_family, V}}; +special(vertex, module, ToType, M) -> + V = {restriction, {get, v}, M}, + special(vertex, function, ToType, V); +special(vertex, application, ToType, A) -> + M = {inverse_image, {get, m2a}, A}, + special(vertex, module, ToType, M); +special(vertex, release, ToType, R) -> + A = {inverse_image, {get, a2r}, R}, + special(vertex, application, ToType, A). + +line_edges(VEs, CallAt) -> + {put, ?T(ves), VEs, + {put, ?T(m1), + {projection, ?Q({external, fun({{M1,_,_},_}) -> M1 end}), + {get, ?T(ves)}}, + {image, {projection, ?Q({external, fun(C={VV,_L}) -> {VV,C} end}), + {union, {image, {get, CallAt}, {get, ?T(m1)}}}}, + {get, ?T(ves)}}}}. + +%% {(((v1,l1),(v2,l2)),l) : +%% (v1,l1) in DefAt and (v2,l2) in DefAt and ((v1,v2),L) in CallAt} +funs_to_lines(DefAt, CallAt) -> + T1 = multiple_relative_product({DefAt, DefAt}, projection(1, CallAt)), + T2 = composite(substitution(1, T1), CallAt), + Fun = fun({{{V1,V2},{L1,L2}},Ls}) -> {{{V1,L1},{V2,L2}},Ls} end, + projection({external, Fun}, T2). + +what_type('Rel') -> release; +what_type('App') -> application; +what_type('Mod') -> module; +what_type('Fun') -> function; +what_type('Lin') -> {line, line}; +what_type('LLin') -> {line, local_call}; +what_type('XLin') -> {line, external_call}; +what_type('ELin') -> {line, export_call}; +what_type('XXL') -> {line, all_line_call}. + +type_ord({line, all_line_call}) -> 0; +type_ord({line, _LT}) -> 1; +type_ord(function) -> 2; +type_ord(module) -> 3; +type_ord(application) -> 4; +type_ord(release) -> 5. + +%% While evaluating, sets of vertices are represented as families. +%% Sets of edges are not families, but plain sets (this might change). +%% Calls (with line numbers) are "straightened" out here, but will be +%% families again shortly, unless just counted. +un_familiarize(function, vertex, E) -> + {union_of_family, E}; +un_familiarize({line, _}, edge, E) -> + {family_to_relation, E}; +un_familiarize(_Type, _OType, E) -> + E. + +%% Expressions are evaluated using a stack and tail recursion. +%% Common subexpressions are evaluated once only, using a table for +%% storing temporary results. +%% (Using a table _and_ a stack is perhaps not a very good way of +%% doing things.) +i(E, Table) -> + Start = 1, + {N, _NE, _NI, NT} = find_nodes(E, Start, dict:new()), + {Vs, UVs0, L} = save_vars(dict:to_list(NT), NT, [], [], []), + + VarsToSave = to_external(relation_to_family(relation(Vs))), + Fun = fun({NN,S}, D) -> + dict:store(NN, {extra,S,dict:fetch(NN, D)}, D) + end, + D = foldl(Fun, dict:from_list(L), VarsToSave), + + UVs = reverse(sort(UVs0)), + {_D, Is0} = make_instructions(N, UVs, D), + Is = insert_unput(Is0), + ?FORMAT("Instructions:~n~p~n~n~n", [Is]), + %% Well, compiles _and_ evaluates... + evaluate(Is, Table, []). + +%% Traverses the expression tree in postorder, giving a unique number +%% to each node. A table is created, and common subexpressions found. +find_nodes(E={quote,_}, I, T) -> + find_node(E, I, T); +find_nodes({get, Var}, I, T) -> + find_node({var,Var}, I, T); +find_nodes({put, Var, E1, E2}, I, T) -> + {_NE1_N, NE1, I1, T1} = find_nodes(E1, I, T), + %% Now NE1 is considered used once, which is wrong. Fixed below. + NT = dict:store({var, Var}, NE1, T1), + find_nodes(E2, I1, NT); +find_nodes(Tuple, I, T) when is_tuple(Tuple) -> + [Tag0 | L] = tuple_to_list(Tuple), + Fun = fun(A, {L0, I0, T0}) -> + {NA, _E, NI, NT} = find_nodes(A, I0, T0), + {[NA | L0], NI, NT} + end, + {NL, NI, T1} = foldl(Fun, {[], I, T}, L), + Tag = case Tag0 of + _ when is_function(Tag0) -> Tag0; + _ when is_atom(Tag0) -> {sofs, Tag0} + end, + find_node({apply, Tag, NL}, NI, T1). + +find_node(E, I, T) -> + case dict:find(E, T) of + {ok, {reuse, N}} -> + {N, E, I, T}; + {ok, N} when is_integer(N) -> + {N, E, I, dict:store(E, {reuse, N}, T)}; + {ok, E1} -> + find_node(E1, I, T); + error -> + {I, E, I+1, dict:store(E, I, T)} + end. + +%% Creates save instructions for those values (stored on the stack while +%% evaluating) that are to be used after the result has been popped. +save_vars([{I, {reuse,N}} | DL], D, Vs, UVs, L) -> + save_vars(DL, D, [{N, {save, {tmp, N}}} | Vs], UVs, [{N, I} | L]); +save_vars([{I, N} | DL], D, Vs, UVs, L) when is_integer(N) -> + save_vars(DL, D, Vs, UVs, [{N, I} | L]); +save_vars([{{var,V={user,_}}, I} | DL], D, Vs, UVs, L) -> + N = case dict:fetch(I, D) of + {reuse, N0} -> N0; + N0 -> N0 + end, + save_vars(DL, D, [{N, {save, V}} | Vs], [N | UVs], L); +save_vars([{{var,{tmp,_}}, _I} | DL], D, Vs, UVs, L) -> + save_vars(DL, D, Vs, UVs, L); +save_vars([], _D, Vs, UVs, L) -> + {Vs, UVs, L}. + +%% Traverses the expression again, this time using more or less the +%% inverse of the table created by find_nodes. The first time a node +%% is visited, its children are traversed, the following times a +%% get instructions are inserted (using the saved value). +make_instructions(N, UserVars, D) -> + {D1, Is0} = make_instrs(N, D, []), + %% Assignments the results of which are not used by the final + %% expression are handled here. Instructions are created for user + %% variables only (assignment of a closure is handled properly + %% without further action). + make_more_instrs(UserVars, D1, Is0). + +make_more_instrs([UV | UVs], D, Is) -> + case dict:find(UV, D) of + error -> + make_more_instrs(UVs, D, Is); + _Else -> + {ND, NIs} = make_instrs(UV, D, Is), + make_more_instrs(UVs, ND, [pop | NIs]) + end; +make_more_instrs([], D, Is) -> + {D, Is}. + +make_instrs(N, D, Is) -> + case dict:find(N, D) of + {ok, {extra, Save, Val}} -> + {D1, Is1} = make_instr(Val, D, Is), + {dict:erase(N, D1), Save ++ Is1}; + {ok, Val} -> + {D1, Is1} = make_instr(Val, D, Is), + {dict:erase(N, D1), Is1}; + error -> + {D, [{get, {tmp, N}} | Is]} + end. + +make_instr({var, V}, D, Is) -> + {D, [{get, V} | Is]}; +make_instr(Q = {quote, _T}, D, Is) -> + {D, [Q | Is]}; +make_instr({apply, MF, Ns}, D, Is) -> + Fun = fun(N, {D0, Is0}) -> make_instrs(N, D0, Is0) end, + {D1, Is1} = foldl(Fun, {D, Is}, Ns), + {D1, [{apply, MF, length(Ns)} | Is1]}. + +%% Makes sure that temporary results are removed from the table as soon +%% as they are no longer needed. +%% Assignments may create extra save instructions, which are removed here. +insert_unput(L) -> + insert_unput(L, dict:new(), []). + +insert_unput([I={get, V={tmp, _}} | Is], D, L) -> + case dict:find(V, D) of + {ok, _} -> insert_unput(Is, D, [I | L]); + error -> insert_unput(Is, dict:store(V, [], D), [I, {unput, V} | L]) + end; +insert_unput([I={save, V={tmp,_}} | Is], D, L) -> + case dict:find(V, D) of + {ok, _} -> + insert_unput(Is, dict:erase(V, D), [I | L]); + error -> + %% Extra save removed. + insert_unput(Is, dict:erase(V, D), L) + end; +insert_unput([I | Is], D, L) -> + insert_unput(Is, D, [I | L]); +insert_unput([], _D, L) -> + L. + +graph_access(_G, V) -> + %% _G may have been deleted by an unput already + V. + +evaluate([{apply, MF, NoAs} | P], T, S) -> + Args = sublist(S, NoAs), + NewS = nthtail(NoAs, S), + ?FORMAT("Applying ~p/~p~n", [MF,NoAs]), + evaluate(P, T, [apply(MF, Args) | NewS]); +evaluate([{quote, Val} | P], T, S) -> + evaluate(P, T, [Val | S]); +evaluate([{get, Var} | P], T, S) when is_atom(Var) -> % predefined + Value = fetch_value(Var, T), + Val = case Value of + {R, _} -> R; % relation + _ -> Value % simple set + end, + evaluate(P, T, [Val | S]); +evaluate([{get, {inverse, Var}} | P], T, S) -> % predefined, inverse + {_, R} = fetch_value(Var, T), + evaluate(P, T, [R | S]); +evaluate([{get, {user, Var}} | P], T, S) -> + Val = fetch_value(Var, T), + evaluate(P, T, [Val | S]); +evaluate([{get, Var} | P], T, S) -> % tmp + evaluate(P, T, [dict:fetch(Var, T) | S]); +evaluate([{save, Var={tmp, _}} | P], T, S=[Val | _]) -> + T1 = update_graph_counter(Val, +1, T), + evaluate(P, dict:store(Var, Val, T1), S); +evaluate([{save, {user, Name}} | P], T, S=[Val | _]) -> + #xref_var{vtype = user, otype = OType, type = Type} = dict:fetch(Name, T), + NewVar = #xref_var{name = Name, value = Val, + vtype = user, otype = OType, type = Type}, + T1 = update_graph_counter(Val, +1, T), + NT = dict:store(Name, NewVar, T1), + evaluate(P, NT, S); +evaluate([{unput, Var} | P], T, S) -> + T1 = update_graph_counter(dict:fetch(Var, T), -1, T), + evaluate(P, dict:erase(Var, T1), S); +evaluate([pop | P], T, [_ | S]) -> + evaluate(P, T, S); +evaluate([], T, [R]) -> + {T, R}. + +%% (PossibleGraph, 1 | -1, dict()) -> dict() +%% Use the same table for everything... Here: Reference counters for digraphs. +update_graph_counter(Value, Inc, T) -> + case catch digraph:info(Value) of + Info when is_list(Info) -> + case dict:find(Value, T) of + {ok, 1} when Inc =:= -1 -> + true = digraph:delete(Value), + dict:erase(Value, T); + {ok, C} -> + dict:store(Value, C+Inc, T); + error when Inc =:= 1 -> + dict:store(Value, 1, T) + end; + _EXIT -> + T + end. + +fetch_value(V, D) -> + #xref_var{value = Value} = dict:fetch(V, D), + Value. + +format_parse_error(["invalid_regexp", String, Error], Line) -> + io_lib:format("Invalid regular expression \"~s\"~s: ~s~n", + [String, Line, lists:flatten(Error)]); +format_parse_error(["invalid_regexp_variable", Var], Line) -> + io_lib:format("Invalid wildcard variable ~p~s " + "(only '_' is allowed)~n", [Var, Line]); +format_parse_error(["missing_type", Expr], Line) -> + io_lib:format("Missing type of regular expression ~s~s~n", + [Expr, Line]); +format_parse_error(["type_mismatch", Expr], Line) -> + io_lib:format("Type does not match structure of constant~s: ~s~n", + [Line, Expr]); +format_parse_error(["invalid_operator", Op], Line) -> + io_lib:format("Invalid operator ~p~s~n", [Op, Line]); +format_parse_error(Error, Line) -> + io_lib:format("Parse error~s: ~s~n", [Line, lists:flatten(Error)]). + +format_line(-1) -> + " at end of string"; +format_line(0) -> + ""; +format_line(Line) when is_integer(Line) -> + concat([" on line ", Line]). + +throw_error(Reason) -> + throw(error(Reason)). + +error(Reason) -> + {error, ?MODULE, Reason}. diff --git a/lib/tools/src/xref_parser.yrl b/lib/tools/src/xref_parser.yrl new file mode 100644 index 0000000000..e23dce1dec --- /dev/null +++ b/lib/tools/src/xref_parser.yrl @@ -0,0 +1,303 @@ +%% +%% %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% +%% + +Nonterminals +xref statements statement expr constants constant const +assign_op prefix_op add_op mult_op count_op restr_op path_op cast_op +regexp regatom regint regvar regstr +variable id type. + +Terminals +edge vertex var atom decl cast 'of' string integer +'(' ')' '[' ']' ',' '+' '-' '*' '|' '||' '|||' '=' ':=' '#' '{' '}' ':' '/'. + +Rootsymbol xref. + +Endsymbol '$end'. + +xref -> statements : '$1'. + +assign_op -> '=' : tmp. +assign_op -> ':=' : user. +add_op -> '+' : union. +add_op -> '-' : difference. +mult_op -> '*' : intersection. +count_op -> '#' : '#'. +restr_op -> '|' : '|'. +restr_op -> '||' : '||'. +restr_op -> '|||' : '|||'. +path_op -> 'of' : 'of'. +cast_op -> '(' cast ')' : value_of('$2'). +prefix_op -> id : '$1'. + +Left 200 add_op. +Left 300 mult_op. +Left 400 count_op. +Left 500 restr_op. +Left 600 path_op. +Unary 700 cast_op. +Unary 700 prefix_op. + +statements -> statement : ['$1']. +statements -> expr : ['$1']. +statements -> statement ',' statements : ['$1' | '$3']. + +statement -> variable assign_op expr : {assign, '$2', '$1', '$3'}. + +expr -> '[' constant constants ']' type : type({list, ['$2' | '$3']}, '$5'). +expr -> '{' constant constants '}' type : type({tuple, ['$2' | '$3']}, '$5'). +expr -> constant type : type('$1', '$2'). +expr -> variable : {variable, '$1'}. +expr -> expr add_op expr : {set, '$2', '$1', '$3'}. +expr -> expr mult_op expr : {set, '$2', '$1', '$3'}. +expr -> count_op expr : prefix('$1', '$2'). +expr -> expr restr_op expr : {restr, '$2', '$1', '$3'}. +expr -> expr path_op expr : {path, '$1', '$3'}. +expr -> cast_op expr : {type, {convert, '$1'}, '$2'}. +expr -> prefix_op expr : prefix('$1', '$2'). +expr -> regexp : '$1'. +expr -> '(' expr ')' : '$2'. + +constants -> '$empty' : []. +constants -> ',' constant constants : ['$2' | '$3']. + +constant -> const : '$1'. + +const -> id : {constant, unknown, vertex, '$1'}. +const -> edge : value_of('$1'). +const -> vertex : value_of('$1'). + +regexp -> regstr type : regexp(atom, '$1', '$2'). +regexp -> regatom ':' regatom '/' regint type : + regexp(func, {'$1', '$3', '$5'}, '$6'). + +regatom -> regstr : '$1'. +regatom -> id : {atom, '$1'}. +regatom -> regvar : '$1'. + +regint -> regstr : '$1'. +regint -> integer : {integer, value_of('$1')}. +regint -> regvar : '$1'. + +regstr -> string : check_regexp(value_of('$1')). +regvar -> variable : check_regexp_variable('$1'). + +id -> atom : value_of('$1'). +variable -> var : value_of('$1'). + +type -> decl : value_of('$1'). +type -> '$empty' : unknown. + +Erlang code. + +-export([t2s/1]). + +-import(lists, [concat/1, flatten/1]). + +%%% Syntax of the parse tree: +%%% Start = [Statement] +%%% Statement = {assign, AOp, VarName, Expr} +%%% | Expr +%%% AOp = tmp | user +%%% Expr = Constants | Variable | Unary | Binary | RegExpr +%%% Constants = {list, [Constant]} % not empty list +%%% | {tuple, [Constant]} +%%% | Constant % only to avoid [ and ] in error messages... +%%% Constant = {constant, 'Fun', vertex, MFA} | +%%% {constant, AtomType, vertex, atom()} | +%%% {constant, 'Fun', edge, {MFA, MFA}} | +%%% {constant, AtomType, edge, {atom(), atom()}} +%%% Variable = {variable, VarName} +%%% VarName = atom() +%%% Unary = {set, SetUOp, Expr} +%%% | {graph, GraphUOp, Expr} +%%% | {type, {TypeOp, Type}, Expr} +%%% | {numeric, NumOp, Expr, Expr} +%%% SetUOp = range | domain | weak | strict +%%% GraphUOp = components | condensation | closure +%%% Binary = {set, SetBOp, Expr, Expr} +%%% | {restr, RestrOp, Expr, Expr} +%%% | {path, Expr, Expr} +%%% SetBOp = union | intersection | difference +%%% RestrOp = '|' | '||' | '|||' +%%% TypeOp = type | convert +%%% NumOp = '#' +%%% RegExpr = {regexpr, RExpr, Type} +%%% RExpr = string() | {AtomReg, AtomReg, IntReg} +%%% AtomReg = string() | atom() | variable() +%%% IntReg = string() | integer() +%%% MFA = {atom(), atom(), integer()} +%%% Type = 'Rel' | 'App' | 'Mod' | 'Fun' +%%% | 'Lin' | 'LLin' | 'XLin' | 'ELin' | 'XXL' +%%% AtomType = unknown | 'Rel' | 'App' | 'Mod' + +value_of(Token) -> + element(3, Token). + +prefix(Op, Expr) -> + case is_prefix_op(Op) of + false -> + return_error(0, ["invalid_operator", Op]); + UOp -> + {UOp, Op, Expr} + end. + +is_prefix_op(range) -> set; +is_prefix_op(domain) -> set; +is_prefix_op(weak) -> set; +is_prefix_op(strict) -> set; +is_prefix_op(components) -> graph; +is_prefix_op(condensation) -> graph; +is_prefix_op(closure) -> graph; +is_prefix_op('#') -> numeric; +is_prefix_op(_) -> false. + +check_regexp(String) -> + case regexp:parse(String) of + {ok, _Expr} -> + {regexpr, String}; + {error, Reason} -> + F = regexp:format_error(Reason), + return_error(0, ["invalid_regexp", String, F]) + end. + +check_regexp_variable('_') -> + variable; +check_regexp_variable(Var) -> + return_error(0, ["invalid_regexp_variable", Var]). + +regexp(func, RExpr, unknown) -> + {regexpr, RExpr, 'Fun'}; +regexp(_, RExpr, unknown) -> + return_error(0, ["missing_type", t2s({regexpr, RExpr, unknown})]); +regexp(Kind, RExpr, Type) -> + E = {type, {type, Type}, {regexpr, RExpr, Type}}, + case Type of + 'Fun' when Kind =:= func -> E; + 'Mod' when Kind =:= atom -> E; + 'App' when Kind =:= atom -> E; + 'Rel' when Kind =:= atom -> E; + _Else -> return_error(0, ["type_mismatch", t2s(E)]) + end. + +type(Expr, unknown) -> + Expr; +type(Expr, Type) -> + {type, {type, Type}, type_constants(Expr, Type, Expr)}. + +type_constants({list, L}, Type, E) -> + {list, type_constants(L, Type, E)}; +type_constants({tuple, L}, Type, E) -> + {tuple, type_constants(L, Type, E)}; +type_constants([C | Cs], Type, E) -> + [type_constants(C, Type, E) | type_constants(Cs, Type, E)]; +type_constants([], _Type, _E) -> + []; +type_constants({constant, unknown, OType, Con}, 'Rel', _E) -> + {constant, 'Rel', OType, Con}; +type_constants({constant, unknown, OType, Con}, 'App', _E) -> + {constant, 'App', OType, Con}; +type_constants({constant, unknown, OType, Con}, 'Mod', _E) -> + {constant, 'Mod', OType, Con}; +type_constants(C={constant, Type, _OType, _Con}, Type, _E) -> + C; +type_constants(_C, Type, E) -> + return_error(0, ["type_mismatch", t2s({type, {type, Type}, E})]). + +t2s(T) -> + concat(flatten(e2s(T, 0))). + +%% Does not handle list of statements. +e2s({assign, VarType, Name, E}, P) -> + [left(P, 100), Name, name_it(VarType), e2s(E, 100), right(P, 100)]; +e2s({constant, 'Fun', vertex, MFA}, _P) -> + mfa2s(MFA); +e2s({constant, _Type, vertex, A}, _P) -> + [c2s(A)]; +e2s({constant, 'Fun', edge, {MFA1,MFA2}}, _P) -> + [mfa2s(MFA1),' -> ',mfa2s(MFA2)]; +e2s({constant, _Type, edge, {A1,A2}}, _P) -> + [c2s(A1),' -> ',c2s(A2)]; +e2s({variable, Name}, _P) -> + [Name]; +e2s({list, E}, _P) -> + ['[', e2s(E, 0), ']']; +e2s({tuple, E}, _P) -> + ['{', e2s(E, 0), '}']; +e2s({type, {convert, Type}, E}, P) -> + [left(P, 700), '(',Type,') ', e2s(E, 700), right(P, 700)]; +e2s({type, {type, Type}, E}, P) -> + [left(P, 700), e2s(E, 700), ' : ', Type, right(P, 700)]; +e2s({set, Op, E}, P) -> + [left(P, 700), name_it(Op), ' ', e2s(E, 700), right(P, 700)]; +e2s({graph, Op, E}, P) -> + [left(P, 700), name_it(Op), ' ', e2s(E, 700), right(P, 700)]; +e2s({numeric, Op, E}, P) -> + [left(P, 400), name_it(Op), ' ', e2s(E, 400), right(P, 400)]; +e2s({set, Op, E1, E2}, P) -> + P1 = prio(Op), + [left(P, P1), e2s(E1, P1),name_it(Op),e2s(E2, P1+50), right(P, P1)]; +e2s({path, E1, E2}, P) -> + P1 = 600, + [left(P, P1), e2s(E1, P1),' of ',e2s(E2, P1+50), right(P, P1)]; +e2s({regexpr, Expr={regexpr,_}, _Type}, _P) -> + [re(Expr)]; +e2s({regexpr, {M,F,A}, _Type}, _P) -> + [re(M),':',re(F),'/', re(A)]; +e2s({restr, Op, E1, E2}, P) -> + P1 = 500, + [left(P, P1), e2s(E1, P1),name_it(Op),e2s(E2, P1+50), right(P, P1)]; +e2s([], _P) -> + []; +e2s([E], P) -> + e2s(E, P); +e2s([E | Es], P) -> + [e2s(E, P),', ',e2s(Es, P)]. + +mfa2s({M,F,A}) -> + [c2s(M),':',c2s(F),'/',A]. + +c2s(C) -> + [S] = io_lib:format("~p", [C]), + list_to_atom(S). + +re(variable) -> ['_']; +re({atom, Atom}) -> [Atom]; +re({integer, Int}) -> [Int]; +re({regexpr, Str}) -> ['"',erlang:list_to_atom(Str),'"']. + +left(P1, P2) when P1 > P2 -> ['(']; +left(_P1, _P2) -> []. + +right(P1, P2) when P1 > P2 -> [')']; +right(_P1, _P2) -> []. + +prio(intersection) -> 300; +prio(difference) -> 200; +prio(union) -> 200. + +name_it(tmp) -> ' = '; +name_it(user) -> ' := '; +name_it('|') -> ' | '; +name_it('||') -> ' || '; +name_it('|||') -> ' ||| '; +name_it(union) -> ' + '; +name_it(intersection) -> ' * '; +name_it(difference) -> ' - '; +name_it(Name) -> Name. diff --git a/lib/tools/src/xref_reader.erl b/lib/tools/src/xref_reader.erl new file mode 100644 index 0000000000..db755c31d8 --- /dev/null +++ b/lib/tools/src/xref_reader.erl @@ -0,0 +1,352 @@ +%% +%% %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(xref_reader). + +-export([module/5]). + +-import(lists, [keysearch/3, member/2, reverse/1]). + +-record(xrefr, + {module=[], + function=[], + def_at=[], + l_call_at=[], + x_call_at=[], + el=[], + ex=[], + x=[], + df, + builtins_too=false, + is_abstr, % abstract module? + funvars=[], % records variables bound to funs + % (for coping with list comprehension) + matches=[], % records other bound variables + unresolved=[], % unresolved calls, {{mfa(),mfa()},Line} + %% experimental; -xref(FunEdge) is recognized. + lattrs=[], % local calls, {{mfa(),mfa()},Line} + xattrs=[], % external calls, -"- + battrs=[] % badly formed xref attributes, term(). + }). + +-include("xref.hrl"). + +%% sys_pre_expand has modified the forms slightly compared to what +%% erl_id_trans recognizes. + +%% The versions of the abstract code are as follows: +%% R7: abstract_v1 +%% R8: abstract_v2 + +%% -> {ok, Module, {DefAt, CallAt, LC, XC, X, Attrs}, Unresolved}} | EXIT +%% Attrs = {ALC, AXC, Bad} +%% ALC, AXC and Bad are extracted from the attribute 'xref'. An experiment. +module(Module, Forms, CollectBuiltins, X, DF) -> + Attrs = [{Attr,V} || {attribute,_Line,Attr,V} <- Forms], + IsAbstract = xref_utils:is_abstract_module(Attrs), + S = #xrefr{module = Module, builtins_too = CollectBuiltins, + is_abstr = IsAbstract, x = X, df = DF}, + forms(Forms, S). + +forms([F | Fs], S) -> + S1 = form(F, S), + forms(Fs, S1); +forms([], S) -> + #xrefr{module = M, def_at = DefAt, + l_call_at = LCallAt, x_call_at = XCallAt, + el = LC, ex = XC, x = X, df = Depr, + lattrs = AL, xattrs = AX, battrs = B, unresolved = U} = S, + Attrs = {lists:reverse(AL), lists:reverse(AX), lists:reverse(B)}, + {ok, M, {DefAt, LCallAt, XCallAt, LC, XC, X, Attrs, Depr}, U}. + +form({attribute, Line, xref, Calls}, S) -> % experimental + #xrefr{module = M, function = Fun, + lattrs = L, xattrs = X, battrs = B} = S, + attr(Calls, Line, M, Fun, L, X, B, S); +form({attribute, _Line, _Attr, _Val}, S) -> + S; +form({function, 0, 'MNEMOSYNE RULE', 1, _Clauses}, S) -> + S; +form({function, 0, 'MNEMOSYNE QUERY', 2, _Clauses}, S) -> + S; +form({function, 0, 'MNEMOSYNE RECFUNDEF', 1, _Clauses}, S) -> + S; +form({function, 0, module_info, 0, _Clauses}, S) -> + S; +form({function, 0, module_info, 1, _Clauses}, S) -> + S; +form({function, Line, Name, Arity, Clauses}, S) -> + MFA0 = {S#xrefr.module, Name, Arity}, + MFA = adjust_arity(S, MFA0), + S1 = S#xrefr{function = MFA}, + S2 = S1#xrefr{def_at = [{MFA,Line} | S#xrefr.def_at]}, + S3 = clauses(Clauses, S2), + S3#xrefr{function = []}. + +clauses(Cls, S) -> + #xrefr{funvars = FunVars, matches = Matches} = S, + clauses(Cls, FunVars, Matches, S). + +clauses([{clause, _Line, _H, G, B} | Cs], FunVars, Matches, S) -> + S1 = case S#xrefr.builtins_too of + true -> expr(G, S); + false -> S + end, + S2 = expr(B, S1), + S3 = S2#xrefr{funvars = FunVars, matches = Matches}, + clauses(Cs, S3); +clauses([], _FunVars, _Matches, S) -> + S. + +attr([E={From, To} | As], Ln, M, Fun, AL, AX, B, S) -> + case mfa(From, M) of + {_, _, MFA} when MFA =:= Fun; [] =:= Fun -> + attr(From, To, Ln, M, Fun, AL, AX, B, S, As, E); + {_, _, _} -> + attr(As, Ln, M, Fun, AL, AX, [E | B], S); + _ -> + attr(Fun, E, Ln, M, Fun, AL, AX, B, S, As, E) + end; +attr([To | As], Ln, M, Fun, AL, AX, B, S) -> + attr(Fun, To, Ln, M, Fun, AL, AX, B, S, As, To); +attr([], _Ln, _M, _Fun, AL, AX, B, S) -> + S#xrefr{lattrs = AL, xattrs = AX, battrs = B}. + +attr(From, To, Ln, M, Fun, AL, AX, B, S, As, E) -> + case {mfa(From, M), mfa(To, M)} of + {{true,_,F}, {_,external,T}} -> + attr(As, Ln, M, Fun, AL, [{{F,T},Ln} | AX], B, S); + {{true,_,F}, {_,local,T}} -> + attr(As, Ln, M, Fun, [{{F,T},Ln} | AL], AX, B, S); + _ -> attr(As, Ln, M, Fun, AL, AX, [E | B], S) + end. + +mfa({F,A}, M) when is_atom(F), is_integer(A) -> + {true, local, {M,F,A}}; +mfa(MFA={M,F,A}, M1) when is_atom(M), is_atom(F), is_integer(A) -> + {M=:=M1, external, MFA}; +mfa(_, _M) -> false. + +expr({'if', _Line, Cs}, S) -> + clauses(Cs, S); +expr({'case', _Line, E, Cs}, S) -> + S1 = expr(E, S), + clauses(Cs, S1); +expr({'receive', _Line, Cs}, S) -> + clauses(Cs, S); +expr({'receive', _Line, Cs, To, ToEs}, S) -> + S1 = expr(To, S), + S2 = expr(ToEs, S1), + clauses(Cs, S2); +expr({'try',_Line,Es,Scs,Ccs,As}, S) -> + S1 = expr(Es, S), + S2 = clauses(Scs, S1), + S3 = clauses(Ccs, S2), + expr(As, S3); +expr({call, Line, + {remote, _, {atom,_,erlang}, {atom,_,make_fun}}, + [{atom,_,Mod}, {atom,_,Fun}, {integer,_,Arity}]}, S) -> + %% Added in R10B-6. M:F/A. + expr({'fun', Line, {function, Mod, Fun, Arity}}, S); +expr({'fun', Line, {function, Mod, Name, Arity}}, S) -> + %% Added in R10B-6. M:F/A. + As = lists:duplicate(Arity, {atom, Line, foo}), + external_call(Mod, Name, As, Line, false, S); +expr({'fun', Line, {function, Name, Arity}, _Extra}, S) -> + %% Added in R8. + handle_call(local, S#xrefr.module, Name, Arity, Line, S); +expr({'fun', _Line, {clauses, Cs}, _Extra}, S) -> + clauses(Cs, S); +expr({call, Line, {atom, _, Name}, As}, S) -> + S1 = handle_call(local, S#xrefr.module, Name, length(As), Line, S), + expr(As, S1); +expr({call, Line, {remote, _Line, {atom,_,Mod}, {atom,_,Name}}, As}, S) -> + external_call(Mod, Name, As, Line, false, S); +expr({call, Line, {remote, _Line, Mod, Name}, As}, S) -> + %% Added in R8. + external_call(erlang, apply, [Mod, Name, list2term(As)], Line, true, S); +expr({call, Line, F, As}, S) -> + external_call(erlang, apply, [F, list2term(As)], Line, true, S); +expr({match, _Line, {var,_,Var}, {'fun', _, {clauses, Cs}, _Extra}}, S) -> + %% This is what is needed in R7 to avoid warnings for the functions + %% that are passed around by the "expansion" of list comprehension. + S1 = S#xrefr{funvars = [Var | S#xrefr.funvars]}, + clauses(Cs, S1); +expr({match, _Line, {var,_,Var}, E}, S) -> + %% Used for resolving code like + %% Args = [A,B], apply(m, f, Args) + S1 = S#xrefr{matches = [{Var, E} | S#xrefr.matches]}, + expr(E, S1); +expr(T, S) when is_tuple(T) -> + expr(tuple_to_list(T), S); +expr([E | Es], S) -> + expr(Es, expr(E, S)); +expr(_E, S) -> + S. + +%% Mod and Fun may not correspond to something in the abstract code, +%% which is signalled by X =:= true. +external_call(Mod, Fun, ArgsList, Line, X, S) -> + Arity = length(ArgsList), + W = case xref_utils:is_funfun(Mod, Fun, Arity) of + true when erlang =:= Mod, apply =:= Fun, 2 =:= Arity -> apply2; + true when erts_debug =:= Mod, apply =:= Fun,4 =:= Arity -> debug4; + true when erlang =:= Mod, spawn_opt =:= Fun -> Arity - 1; + true -> Arity; + false when Mod =:= erlang -> + case erl_internal:type_test(Fun, Arity) of + true -> type; + false -> false + end; + false -> false + end, + S1 = if + W =:= type; X -> + S; + true -> + handle_call(external, Mod, Fun, Arity, Line, S) + end, + case {W, ArgsList} of + {false, _} -> + expr(ArgsList, S1); + {type, _} -> + expr(ArgsList, S1); + {apply2, [{tuple, _, [M,F]}, ArgsTerm]} -> + eval_args(M, F, ArgsTerm, Line, S1, ArgsList, []); + {1, [{tuple, _, [M,F]} | R]} -> % R = [] unless spawn_opt + eval_args(M, F, list2term([]), Line, S1, ArgsList, R); + {2, [Node, {tuple, _, [M,F]} | R]} -> % R = [] unless spawn_opt + eval_args(M, F, list2term([]), Line, S1, ArgsList, [Node | R]); + {3, [M, F, ArgsTerm | R]} -> % R = [] unless spawn_opt + eval_args(M, F, ArgsTerm, Line, S1, ArgsList, R); + {4, [Node, M, F, ArgsTerm | R]} -> % R = [] unless spawn_opt + eval_args(M, F, ArgsTerm, Line, S1, ArgsList, [Node | R]); + {debug4, [M, F, ArgsTerm, _]} -> + eval_args(M, F, ArgsTerm, Line, S1, ArgsList, []); + _Else -> % apply2, 1 or 2 + check_funarg(W, ArgsList, Line, S1) + end. + +eval_args(Mod, Fun, ArgsTerm, Line, S, ArgsList, Extra) -> + {IsSimpleCall, M, F} = mod_fun(Mod, Fun), + case term2list(ArgsTerm, [], S) of + undefined -> + S1 = unresolved(M, F, -1, Line, S), + expr(ArgsList, S1); + ArgsList2 when not IsSimpleCall -> + S1 = unresolved(M, F, length(ArgsList2), Line, S), + expr(ArgsList, S1); + ArgsList2 when IsSimpleCall -> + S1 = expr(Extra, S), + external_call(M, F, ArgsList2, Line, false, S1) + end. + +mod_fun({atom,_,M1}, {atom,_,F1}) -> {true, M1, F1}; +mod_fun({atom,_,M1}, _) -> {false, M1, ?VAR_EXPR}; +mod_fun(_, {atom,_,F1}) -> {false, ?MOD_EXPR, F1}; +mod_fun(_, _) -> {false, ?MOD_EXPR, ?VAR_EXPR}. + +check_funarg(W, ArgsList, Line, S) -> + {FunArg, Args} = fun_args(W, ArgsList), + S1 = case funarg(FunArg, S) of + true -> + S; + false when is_integer(W) -> % 1 or 2 + unresolved(?MOD_EXPR, ?VAR_EXPR, 0, Line, S); + false -> % apply2 + N = case term2list(Args, [], S) of + undefined -> -1; + As -> length(As) + end, + unresolved(?MOD_EXPR, ?VAR_EXPR, N, Line, S) + end, + expr(ArgsList, S1). + +funarg({'fun', _, _Clauses, _Extra}, _S) -> true; +funarg({var, _, Var}, S) -> member(Var, S#xrefr.funvars); +funarg({call,_,{remote,_,{atom,_,erlang},{atom,_,make_fun}},_MFA}, _S) -> + %% R10B-6. M:F/A. + true; +funarg(_, _S) -> false. + +fun_args(apply2, [FunArg, Args]) -> {FunArg, Args}; +fun_args(1, [FunArg | Args]) -> {FunArg, Args}; +fun_args(2, [_Node, FunArg | Args]) -> {FunArg, Args}. + +list2term([A | As]) -> + {cons, 0, A, list2term(As)}; +list2term([]) -> + {nil, 0}. + +term2list({cons, _Line, H, T}, L, S) -> + term2list(T, [H | L], S); +term2list({nil, _Line}, L, _S) -> + reverse(L); +term2list({var, _, Var}, L, S) -> + case keysearch(Var, 1, S#xrefr.matches) of + {value, {Var, E}} -> + term2list(E, L, S); + false -> + undefined + end; +term2list(_Else, _L, _S) -> + undefined. + +unresolved(M, F, A, Line, S) -> + handle_call(external, {M,F,A}, Line, S, true). + +handle_call(Locality, Module, Name, Arity, Line, S) -> + case xref_utils:is_builtin(Module, Name, Arity) of + true when not S#xrefr.builtins_too -> S; + _Else -> + To = {Module, Name, Arity}, + handle_call(Locality, To, Line, S, false) + end. + +handle_call(_Locality, {_, 'MNEMOSYNE RULE',1}, _Line, S, _) -> S; +handle_call(_Locality, {_, 'MNEMOSYNE QUERY', 2}, _Line, S, _) -> S; +handle_call(_Locality, {_, 'MNEMOSYNE RECFUNDEF',1}, _Line, S, _) -> S; +handle_call(Locality, To0, Line, S, IsUnres) -> + From = S#xrefr.function, + To = adjust_arity(S, To0), + Call = {From, To}, + CallAt = {Call, Line}, + S1 = if + IsUnres -> + S#xrefr{unresolved = [CallAt | S#xrefr.unresolved]}; + true -> + S + end, + case Locality of + local -> + S1#xrefr{el = [Call | S1#xrefr.el], + l_call_at = [CallAt | S1#xrefr.l_call_at]}; + external -> + S1#xrefr{ex = [Call | S1#xrefr.ex], + x_call_at = [CallAt | S1#xrefr.x_call_at]} + end. + +adjust_arity(#xrefr{is_abstr = true, module = M}, {M, F, A} = MFA) -> + case xref_utils:is_static_function(F, A) of + true -> + MFA; + false -> + {M,F,A-1} + end; +adjust_arity(_S, MFA) -> + MFA. diff --git a/lib/tools/src/xref_scanner.erl b/lib/tools/src/xref_scanner.erl new file mode 100644 index 0000000000..990f8aa87b --- /dev/null +++ b/lib/tools/src/xref_scanner.erl @@ -0,0 +1,91 @@ +%% +%% %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(xref_scanner). + +-export([scan/1]). + +scan(Chars) -> + case erl_scan:string(Chars) of + {ok, Tokens, _Line} -> + {ok, lex(a1(Tokens))}; + {error, {Line,Module,Info}, _EndLine} -> + {error, Module:format_error(Info), Line} + end. + +a1([{'-',N},{integer,N,1} | L]) -> + [{integer,N,-1} | a1(L)]; +a1([T | L]) -> + [T | a1(L)]; +a1([]) -> + []. + +-define(MFA(M,F,A,N), {atom,N,M}, {':',_}, {atom,_,F}, {'/',_}, {integer,_,A}). +-define(MFA2(M,F,A,N), + {'{',N},{atom,_,M},{',',_},{atom,_,F},{',',_},{integer,_,A},{'}',_}). +-define(DECL(N1,N2,T), {':',N1},{var,N2,T}). + +lex([{atom,N,V1},{'->',_},{atom,_,V2} | L]) -> + Constant = {constant, unknown, edge, {V1,V2}}, + [{edge,N,Constant} | lex(L)]; +lex([{'{',N},{atom,_,V1},{',',_},{atom,_,V2},{'}',_} | L]) -> + Constant = {constant, unknown, edge, {V1,V2}}, + [{edge,N,Constant} | lex(L)]; +lex([?MFA(M,F,A,N),{'->',_},?MFA(M2,F2,A2,_) | L]) -> + Constant = {constant, 'Fun', edge, {{M,F,A},{M2,F2,A2}}}, + [{edge,N,Constant} | lex(L)]; +lex([?MFA(M,F,A,N) | L]) -> + Constant = {constant, 'Fun', vertex, {M,F,A}}, + [{vertex,N,Constant} | lex(L)]; +lex([{'{',N},?MFA2(M,F,A,_),{',',_},?MFA2(M2,F2,A2,_),{'}',_} | L]) -> + Constant = {constant, 'Fun', edge, {{M,F,A},{M2,F2,A2}}}, + [{edge,N,Constant} | lex(L)]; +lex([?MFA2(M,F,A,N) | L]) -> + Constant = {constant, 'Fun', vertex, {M,F,A}}, + [{vertex,N,Constant} | lex(L)]; +lex([?DECL(N1,N2,Decl) | L]) -> + case is_type(Decl) of + false -> [?DECL(N1, N2, Decl) | lex(L)]; + true -> [{decl,N1,Decl} | lex(L)] + end; +lex([{':',N},{'=',_} | L]) -> + [{':=',N} | lex(L)]; +lex([{'||',N},{'|',_} | L]) -> + [{'|||',N} | lex(L)]; +lex([V={var,N,Var} | L]) -> + T = case is_type(Var) of + false -> V; + true -> {cast,N,Var} + end, + [T | lex(L)]; +lex([T | Ts]) -> + [T | lex(Ts)]; +lex([]) -> + [{'$end', -1}]. + +is_type('Rel') -> true; +is_type('App') -> true; +is_type('Mod') -> true; +is_type('Fun') -> true; +is_type('Lin') -> true; +is_type('LLin') -> true; +is_type('XLin') -> true; +is_type('ELin') -> true; +is_type('XXL') -> true; +is_type(_) -> false. diff --git a/lib/tools/src/xref_utils.erl b/lib/tools/src/xref_utils.erl new file mode 100644 index 0000000000..aeb7bf9f1c --- /dev/null +++ b/lib/tools/src/xref_utils.erl @@ -0,0 +1,725 @@ +%% +%% %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(xref_utils). + +-export([xset/2]). + +-export([is_directory/1, file_info/1, fa_to_mfa/2]). + +-export([is_string/2, is_path/1]). + +-export([module_filename/2, application_filename/1, application_filename/2]). + +-export([release_directory/3, select_application_directories/2, + filename_to_application/1, select_last_application_version/1, + split_filename/2, scan_directory/4, list_path/2]). + +-export([predefined_functions/0, is_funfun/3, is_builtin/3]). + +-export([is_static_function/2, is_abstract_module/1]). + +-export([closure/1, components/1, condensation/1, path/2, use/2, call/2]). + +-export([regexpr/2]). + +-export([relation_to_graph/1]). + +-export([find_beam/1]). + +-export([options/2]). + +-export([subprocess/2]). + +-export([format_error/1]). + +-import(lists, [append/1, delete/2, filter/2, foldl/3, foreach/2, + keydelete/3, keysearch/3, keysort/2, last/1, map/2, + member/2, reverse/1, sort/1]). + +-import(sofs, + [difference/2, domain/1, family/1, + family_to_relation/1, from_external/2, from_term/2, + intersection/2, partition/2, relation/1, relation_to_family/1, + restriction/2, set/1, to_external/1, type/1]). + +-include_lib("kernel/include/file.hrl"). + +%% +%% Exported functions +%% + +xset(L, T) when is_list(L) -> + from_external(lists:usort(L), T); +xset(S, T) -> + from_external(S, T). + +%% -> true | false | {error, ?MODULE, Reason} +%is_directory(F) -> +% filelib:is_dir(F); +is_directory(F) -> + case file:read_file_info(F) of + {ok, Info} -> + Info#file_info.type =:= directory; + {error, Error} -> + file_error(F, Error) + end. + +%% file_info(FileName) -> {ok, FileInfo} | {error, ?MODULE, Reason} +%% FileInfo = {FileName, DirOrFile, Readable, ModificationTime} +%% DirOrFile = directory | file +%% Readable = readable | unreadable +%% ModificationTime = {{Year, Month, Day}, {Hour, Minute, Second}} +%% +%% DirOrFile is equal to 'directory' ('file') if FileName is a +%% directory (regular file). +%% Readable is equal 'readable' ('unreadable') if FileName is readable +%% (unreadable). +%% ModificationTime is copied from file_info.mtime. +%% +file_info(F) -> + case file:read_file_info(F) of + {ok, Info} -> + Readable = case Info#file_info.access of + Access when Access =:= read; + Access =:= read_write -> + readable; + _ -> + unreadable + end, + Type = case Info#file_info.type of + directory -> directory; + regular -> file; + _ -> error + end, + case Type of + error -> error({unrecognized_file, F}); + _ -> {ok, {F, Type, Readable, Info#file_info.mtime}} + end; + {error, Error} -> + file_error(F, Error) + end. + + +fa_to_mfa(FAs, Mod) -> + fa_to_mfa(FAs, Mod, []). + +fa_to_mfa([{F,A} | MFs], Mod, L) -> + fa_to_mfa(MFs, Mod, [{Mod,F,A} | L]); +fa_to_mfa([], _Mod, L) -> + reverse(L). + +module_filename(Dir, Module) -> + filename:join(Dir, to_list(Module) ++ code:objfile_extension()). + +application_filename(AppName) -> + to_list(AppName) ++ ".app". + +application_filename(Dir, AppName) -> + filename:join(to_list(Dir), application_filename(AppName)). + +%% -> bool() +is_string([], _) -> + false; +is_string(Term, C) -> + is_string1(Term, C). + +is_string1([H | T], C) when H > C, H < 127 -> + is_string1(T, C); +is_string1([], _) -> + true; +is_string1(_, _) -> + false. + +%% -> bool() +is_path([S | Ss]) -> + case is_string(S, 31) of + true -> + is_path(Ss); + false -> + false + end; +is_path([]) -> + true; +is_path(_) -> + false. + +%==================================== +% Release and application functions. +%==================================== + +%%% ApplDir = {ApplicationName,NumericApplicationVersion,ApplicationDirectory} +%%% ApplicationName = atom() +%%% ApplicationDirectory = string() +%%% NumericApplicationVersion = [integer()] ("3.1.7" becomes [3,1,7]). +%%% [] means that the application has no version... +%%% +%%% ModuleName = ModuleFileName = string() +%%% ReleaseName = atom() + +%% release_directory(Directory, CheckLib, SubDirectory) -> +%% {ok, ReleaseName, AppDir, [ApplDir]} | {error, ?MODULE, Reason} +%% CheckLib = bool() +%% AppDir = string() +%% SubDirectory = string() +%% +%% Returns all sub directories of a given directory, assuming all sub +%% directories are application directories. If a sub directory has a +%% sub directory SubDirectory, that one is chosen as application +%% directory. If Directory has a sub directory 'lib' and CheckLib is +%% equal to 'true', applications are looked for on that +%% directory. ApplDir is the directory where applications reside. In +%% any case, the returned ReleaseName is the basename of the given +%% directory. +%% +release_directory(Dir, UseLib, SubDir) -> + SDir = subdir(Dir, "lib", UseLib), + case file:list_dir(SDir) of + {ok, FileNames} -> + Files = [filename:join(SDir, File) || File <- FileNames], + case select_application_directories(Files, SubDir) of + {ok, ApplDirs} -> + {ok, list_to_atom(filename:basename(Dir)), SDir, ApplDirs}; + Error -> + Error + end; + {error, Error} -> + file_error(SDir, Error) + end. + +%% select_application_directories([FileName], SubDirectory) -> +%% {ok, [ApplDir]} | {error, ?MODULE, Error} +%% SubDirectory = string() +%% +%% For each filename that is a directory, the filename is split into +%% an application name and an application version, if possible, using +%% '-' as separator. If not possible, the empty version - [] - is +%% used. If a directory has a sub directory called SubDirectory, that +%% one is returned as application directory rather than the directory +%% itself. +%% +select_application_directories(FileNames, Dir) -> + select_application_directories(FileNames, Dir, Dir =/= [], []). + +%% filename_to_application(FileName) -> +%% {ApplicationName,NumbericApplicationVersion} +%% +%% Interprets a filename as an application name and an application +%% version. If the filename (the basename actually) cannot be split +%% into two components using '-' as separator, the whole basename is +%% used as application name, and the version returned is []. +%% +filename_to_application(FileName) -> + Basename = filename:basename(FileName), + case catch filename2appl(Basename) of + {'EXIT',_} -> + {list_to_atom(Basename),[]}; + Split -> + Split + end. + +%% select_last_application_version([ApplDir]) -> [ApplDir] +%% +%% For each application that occurs with more than one version in the +%% input list, only the one with the last version is kept. +%% +select_last_application_version(AppVs) -> + TL = to_external(partition(1, relation(AppVs))), + [last(keysort(2, L)) || L <- TL]. + +%% scan_directory(Directory, Recurse, Collect, Watch) -> +%% {Collected, Errors, Seen, Unreadable} +%% +%% Watch = Collect = [string()] +%% Directory = string() | atom() +%% Recurse = bool() +%% Collected = [{Dir,Basename}] +%% Dir = Basename = Seen = Unreadable = [string()] +%% +%% Collected (Seen) contains those regular files with extension +%% occurring in Collect (Watch). Watch is tried only if a filename +%% does not match Collect. Only readable files occur in Collected, the +%% unreadable files (with extension matching Collect) go into +%% Unreadable. +%% +scan_directory(File, Recurse, Collect, Watch) -> + Init = [[] | {[],[],[]}], + [L | {E,J,U}] = find_files_dir(File, Recurse, Collect, Watch, Init), + {reverse(L), reverse(E), reverse(J), reverse(U)}. + +%% {Dir, Basename} | false +split_filename(File, Extension) -> + case catch begin + Dir = filename:dirname(File), + Basename = filename:basename(File, Extension), + {Dir, Basename++Extension} + end of + {'EXIT', _} -> + false; + R -> + R + end. + +%% list_path(Path, Extensions) -> +%% {[{Module, {integer(), Directory, Basename}}], [error()]} +%% +%% Path = [Directory] +%% Extensions = [string()] +%% Module = atom() +%% Directory = Basename = string() +%% +%% Files with any of the given extensions are searched for among +%% the given directories (Path). Directories "below" some of the given +%% directories are not searched (unless enumerated in Path). If some +%% file is found on more than one directory, the first one found is +%% returned (Path is searched from the beginning). +%% +list_path(P, Extensions) -> + list_dirs(P, 1, Extensions, [], []). + +list_dirs([D | Ds], I, Exts, CL, E) -> + Fun = fun(X, A) -> + File = filename:join(D, X), + case is_directory(File) of + false -> + Ext = filename:extension(X), + case member(Ext, Exts) of + true -> + M = list_to_atom(filename:basename(X, Ext)), + [{M, {I,D,X}} | A]; + false -> + A + end; + true -> + A; + _Else -> + A + end + end, + {NCL, NE} = case file:list_dir(D) of + {ok, C0} -> + {foldl(Fun, CL, C0), E}; + {error, Error} -> + {CL, [file_error(D, Error) | E]} + end, + list_dirs(Ds, I+1, Exts, NCL, NE); +list_dirs([], _I, _Exts, C, E) -> + {C, E}. + +%% Returns functions that are present in all modules. +predefined_functions() -> + [{module_info,0}, {module_info,1}]. + +%% Returns true if an MFA takes functional arguments. +is_funfun(erlang, apply, 2) -> true; +is_funfun(erlang, apply, 3) -> true; +is_funfun(erlang, spawn, 1) -> true; +is_funfun(erlang, spawn, 2) -> true; +is_funfun(erlang, spawn, 3) -> true; +is_funfun(erlang, spawn, 4) -> true; +is_funfun(erlang, spawn_link, 1) -> true; +is_funfun(erlang, spawn_link, 2) -> true; +is_funfun(erlang, spawn_link, 3) -> true; +is_funfun(erlang, spawn_link, 4) -> true; +is_funfun(erlang, spawn_opt, 2) -> true; +is_funfun(erlang, spawn_opt, 3) -> true; +is_funfun(erlang, spawn_opt, 4) -> true; +is_funfun(erlang, spawn_opt, 5) -> true; +is_funfun(erts_debug, apply, 4) -> true; +is_funfun(_, _, _) -> false. + +is_builtin(erts_debug, apply, 4) -> true; +is_builtin(M, F, A) -> + erlang:is_builtin(M, F, A). + +is_abstract_module(Attributes) -> + case keysearch(abstract, 1, Attributes) of + {value, {abstract, true}} -> + true; + {value, {abstract, Vals}} when is_list(Vals) -> + member(true, Vals); + _ -> + false + end. + +%% A "static function" is a function in an abstract module that may be +%% called directly. +is_static_function(module_info, 0) -> + true; +is_static_function(module_info, 1) -> + true; +is_static_function(new, _) -> + true; +is_static_function(instance, _) -> + true; +is_static_function(_F, _A) -> + false. + +%%% The following functions implement some of the operators recognized +%%% in xref_compiler.erl. + +closure(S) -> + relation_to_graph(S). + +components(G) -> + %% Returns a plain set of sets. + from_term(digraph_utils:cyclic_strong_components(G), [[atom]]). + +condensation(G) -> + G2 = digraph_utils:condensation(G), + %% A relation. The result can be only be used by a few set operations. + R = graph_to_relation(G2), + true = digraph:delete(G2), + R. + +path(G, [E]) -> + path(G, [E,E]); +path(G, P=[E1 | _]) -> + path(P, G, [[E1]]). + +use(G, V) -> + neighbours(to_external(V), G, reaching_neighbours, type(V)). + +call(G, V) -> + neighbours(to_external(V), G, reachable_neighbours, type(V)). + +regexpr({regexpr, RExpr}, Var) -> + Xs = match_list(to_external(Var), RExpr), + xset(Xs, type(Var)); +regexpr({ModExpr, FunExpr, ArityExpr}, Var) -> + Type = type(Var), + V1 = case {ModExpr,Type} of + {{atom, Mod},[{ModType, _}]} -> + restriction(Var, xset([Mod], [ModType])); + {{regexpr, MExpr},[{ModType, _}]} -> + Mods = match_list(to_external(domain(Var)), MExpr), + restriction(Var, xset(Mods, [ModType])); + {variable,_} -> + Var; + {_,_} -> % Var is the empty set + Var + end, + V2 = case FunExpr of + {atom, FunName} -> + V1L = to_external(V1), + xset(match_one(V1L, FunName, 2), Type); + {regexpr, FExpr} -> + V1L = to_external(V1), + xset(match_many(V1L, FExpr, 2), Type); + variable -> + V1 + end, + case ArityExpr of + {integer, Arity} -> + V2L = to_external(V2), + xset(match_one(V2L, Arity, 3), Type); + {regexpr, Expr} -> + V2L = to_external(V2), + xset(match_many(V2L, Expr, 3), Type); + variable -> + V2 + end. + +%% -> digraph() +relation_to_graph(S) -> + G = digraph:new(), + Fun = fun({From, To}) -> + digraph:add_vertex(G, From), + digraph:add_vertex(G, To), + digraph:add_edge(G, From, To) + end, + foreach(Fun, to_external(S)), + G. + +%% -> {ok, FileName} | Error | fault() +%% Finds a module's BEAM file. +find_beam(Module) when is_atom(Module) -> + case code:which(Module) of + non_existing -> + error({no_such_module, Module}); + preloaded -> + {_M, _Bin, File} = code:get_object_code(Module), + {ok, File}; + cover_compiled -> + error({cover_compiled, Module}); + File -> + {ok, File} + end; +find_beam(Culprit) -> + erlang:error(badarg, [Culprit]). + +%% options(Options, ValidOptions) -> {OptionValues, InvalidOptions} +%% +%% Options = [Option] | Option +%% ValidOptions = [atom() | {OptionName, ValidValues}] +%% OptionValues = [bool() | {OptionName, [term()]}] +%% OptionName = atom() +%% InvalidOptions = [Option] +%% Option = OptionName | {OptionName, term()} +%% ValidValues = [] | [DefaultValue | [ValidValue]] | [DefaultValue, Tester] +%% ValidValue = DefaultValue = term() +%% Tester = fun([term()]) -> bool() +%% +%% A Boolean Option has a name (an atom). A Value Option has a name +%% (an atom) and a value (a term). +%% +%% ValidOptions enumerates allowed options - a Boolean Option is +%% enumerated with its name, and a Value Option is enumerated with a +%% pair {Name, Values}, where Name is the option's name and Values is +%% a list of allowed values for the Value Option, the first one being +%% the default value (by convention). An empty list of allowed values +%% means that all terms are allowed as value (and that there is no +%% default value). Also if the only allowed value is the default +%% value, all terms are allowed as value. A function argument (Tester) +%% may be used for testing the supplied values (useful for a path...) +%% An allowed option must not be enumerated more than once, but +%% allowed values may be duplicated. +%% +%% OptionValues is a list of option values, where member i is the +%% value of option i in ValidOptions. The value of a Boolean Option is +%% 'true' if the option name is mentioned in Options, otherwise +%% 'false'. The value of a Value Option is a list of the option values +%% mentioned in Options for the Value Option. If the Value Option is +%% not mentioned in Options, the list contains the default value (if +%% there is no default value, the list is empty), and if it is +%% mentioned more than once, the values are sorted in standard order. +%% +%% InvalidOptions is a list of those options present in Options that +%% do not match any allowed option mentioned in ValidOptions. +%% +options(Options, Valid) -> + split_options(Options, [], [], [], Valid). + +subprocess(Fun, Opts) -> + Pid = spawn_opt(Fun, Opts), + receive + {Pid, Reply} -> Reply + end. + +format_error({error, Module, Error}) -> + Module:format_error(Error); +format_error({file_error, FileName, Reason}) -> + io_lib:format("~s: ~p~n", [FileName, file:format_error(Reason)]); +format_error({unrecognized_file, FileName}) -> + io_lib:format("~p is neither a regular file nor a directory~n", + [FileName]); +format_error({no_such_module, Module}) -> + io_lib:format("Cannot find module ~p using the code path~n", [Module]); +format_error({interpreted, Module}) -> + io_lib:format("Cannot use BEAM code of interpreted module ~p~n", [Module]); +format_error(E) -> + io_lib:format("~p~n", [E]). + +%% +%% Local functions +%% + +to_list(X) when is_atom(X) -> atom_to_list(X); +to_list(X) when is_list(X) -> X. + +select_application_directories([FileName|FileNames], Dir, Flag, L) -> + case is_directory(FileName) of + true -> + File = filename:basename(FileName), + {Name, Vsn} = filename_to_application(File), + ApplDir = {Name, Vsn, subdir(FileName, Dir, Flag)}, + select_application_directories(FileNames, Dir, Flag, [ApplDir|L]); + false -> + select_application_directories(FileNames, Dir, Flag, L); + Error -> + Error + end; +select_application_directories([], _Dir, _Flag, L) -> + {ok,reverse(L)}. + +subdir(Dir, _, false) -> + Dir; +subdir(Dir, SubDir, true) -> + EDir = filename:join(Dir, SubDir), + case is_directory(EDir) of + true -> EDir; + _FalseOrError -> Dir + end. + +%% Avoid "App-01.01" - the zeroes will be lost. +filename2appl(File) -> + Pos = string:rstr(File, "-"), + true = Pos > 1, + V = string:sub_string(File, Pos+1), + true = string:len(V) > 0, + VsnT = string:tokens(V, "."), + ApplName = string:sub_string(File, 1, Pos-1), + Vsn = [list_to_integer(Vsn) || Vsn <- VsnT], + {list_to_atom(ApplName),Vsn}. + +find_files_dir(Dir, Recurse, Collect, Watch, L) -> + case file:list_dir(Dir) of + {ok, Files} -> + find_files(sort(Files), Dir, Recurse, Collect, Watch, L); + {error, Error} -> + [B | {E,J,U}] = L, + [B | {[file_error(Dir, Error)|E],J,U}] + end. + +find_files([F | Fs], Dir, Recurse, Collect, Watch, L) -> + File = filename:join(Dir, F), + L1 = case file_info(File) of + {ok, {_, directory, readable, _}} when Recurse -> + find_files_dir(File, Recurse, Collect, Watch, L); + {ok, {_, directory, _, _}} -> + L; + Info -> + [B | EJU = {E,J,U}] = L, + Ext = filename:extension(File), + C = member(Ext, Collect), + case C of + true -> + case Info of + {ok, {_, file, readable, _}} -> + [[{Dir,F} | B] | EJU]; + {ok, {_, file, unreadable, _}} -> + [B | {E,J,[File|U]}]; + Error -> + [B | {[Error|E],J,U}] + end; + false -> + case member(Ext, Watch) of + true -> [B | {E,[File|J],U}]; + false -> L + end + end + end, + find_files(Fs, Dir, Recurse, Collect, Watch, L1); +find_files([], _Dir, _Recurse, _Collect, _Watch, L) -> + L. + +graph_to_relation(G) -> + Fun = fun(E) -> {_E, V1, V2, _Label} = digraph:edge(G, E), {V1, V2} end, + from_term(map(Fun, digraph:edges(G)), [{[atom],[atom]}]). + +path([E1, E2 | P], G, L) -> + case digraph:get_short_path(G, E1, E2) of + false -> + false; + [_V | Vs] -> + path([E2 | P], G, [Vs | L]) + end; +path([_], _G, L) -> + append(reverse(L)). + +neighbours(Vs, G, Fun, VT) -> + neighbours(Vs, G, Fun, VT, []). + +neighbours([V | Vs], G, Fun, VT, L) -> + Ns = digraph_utils:Fun([V], G), + neighbours(Ns, G, Fun, VT, L, V, Vs); +neighbours([], _G, _Fun, [VT], L) -> + xset(L, [{VT,VT}]). + +neighbours([N | Ns], G, Fun, VT, L, V, Vs) when Fun =:= reachable_neighbours -> + neighbours(Ns, G, Fun, VT, [{V, N} | L], V, Vs); +neighbours([N | Ns], G, Fun, VT, L, V, Vs) -> + neighbours(Ns, G, Fun, VT, [{N, V} | L], V, Vs); +neighbours([], G, Fun, VT, L, _V, Vs) -> + neighbours(Vs, G, Fun, VT, L). + +match_list(L, RExpr) -> + {ok, Expr} = regexp:parse(RExpr), + filter(fun(E) -> match(E, Expr) end, L). + +match_one(VarL, Con, Col) -> + select_each(VarL, fun(E) -> Con =:= element(Col, E) end). + +match_many(VarL, RExpr, Col) -> + {ok, Expr} = regexp:parse(RExpr), + select_each(VarL, fun(E) -> match(element(Col, E), Expr) end). + +match(I, Expr) when is_integer(I) -> + S = integer_to_list(I), + {match, 1, length(S)} =:= regexp:first_match(S, Expr); +match(A, Expr) when is_atom(A) -> + S = atom_to_list(A), + {match, 1, length(S)} =:= regexp:first_match(S, Expr). + +select_each([{Mod,Funs} | L], Pred) -> + case filter(Pred, Funs) of + [] -> + select_each(L, Pred); + NFuns -> + [{Mod,NFuns} | select_each(L, Pred)] + end; +select_each([], _Pred) -> + []. + +split_options([O | Os], A, P, I, V) when is_atom(O) -> + split_options(Os, [O | A], P, I, V); +split_options([O={Name,_} | Os], A, P, I, V) when is_atom(Name) -> + split_options(Os, A, [O | P], I, V); +split_options([O | Os], A, P, I, V) -> + split_options(Os, A, P, [O | I], V); +split_options([], A, P, I, V) -> + Atoms = to_external(set(A)), + Pairs = to_external(relation_to_family(relation(P))), + option_values(V, Atoms, Pairs, I, []); +split_options(O, A, P, I, V) -> + split_options([O], A, P, I, V). + +option_values([O | Os], A, P, I, Vs) when is_atom(O) -> + option_values(Os, delete(O, A), P, I, [member(O, A) | Vs]); +option_values([{Name, AllowedValues} | Os], A, P, I, Vs) -> + case keysearch(Name, 1, P) of + {value, {_, Values}} -> + option_value(Name, AllowedValues, Values, A, P, I, Vs, Os); + false when AllowedValues =:= [] -> + option_values(Os, A, P, I, [[] | Vs]); + false -> + [Default | _] = AllowedValues, + option_values(Os, A, P, I, [[Default] | Vs]) + end; +option_values([], A, P, Invalid, Values) -> + I2 = to_external(family_to_relation(family(P))), + {reverse(Values), Invalid ++ A ++ I2}. + +option_value(Name, [_Deflt, Fun], Vals, A, P, I, Vs, Os) + when is_function(Fun) -> + P1 = keydelete(Name, 1, P), + case Fun(Vals) of + true -> + option_values(Os, A, P1, I, [Vals | Vs]); + false -> + option_values(Os, A, [{Name,Vals} | P1], I, [[] | Vs]) + end; +option_value(Name, AllowedValues, Values, A, P, I, Vs, Os) -> + P1 = keydelete(Name, 1, P), + VS = set(Values), + AVS = set(AllowedValues), + V1 = to_external(intersection(VS, AVS)), + {V, NP} = case to_external(difference(VS, AVS)) of + _ when AllowedValues =:= [] -> {Values,P1}; + [] -> {V1,P1}; + _ when length(AllowedValues) =:= 1 -> + {Values,P1}; + I1 -> {V1,[{Name,I1} | P1]} + end, + option_values(Os, A, NP, I, [V | Vs]). + +file_error(File, Error) -> + error({file_error, File, Error}). + +error(Error) -> + {error, ?MODULE, Error}. diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk new file mode 100644 index 0000000000..644e8b719b --- /dev/null +++ b/lib/tools/vsn.mk @@ -0,0 +1,19 @@ +# This is an -*-makefile-*- file. +# %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% + +TOOLS_VSN = 2.6.5 -- cgit v1.2.3